xref: /petsc/src/ts/interface/ts.c (revision a126751eb7c22282655f26917f2fb121ff6a923a)
1 #include <petsc/private/tsimpl.h>        /*I "petscts.h"  I*/
2 #include <petscdmshell.h>
3 #include <petscdmda.h>
4 #include <petscviewer.h>
5 #include <petscdraw.h>
6 
7 /* Logging support */
8 PetscClassId  TS_CLASSID, DMTS_CLASSID;
9 PetscLogEvent TS_AdjointStep, TS_Step, TS_PseudoComputeTimeStep, TS_FunctionEval, TS_JacobianEval;
10 
11 const char *const TSExactFinalTimeOptions[] = {"UNSPECIFIED","STEPOVER","INTERPOLATE","MATCHSTEP","TSExactFinalTimeOption","TS_EXACTFINALTIME_",0};
12 
13 struct _n_TSMonitorDrawCtx {
14   PetscViewer   viewer;
15   Vec           initialsolution;
16   PetscBool     showinitial;
17   PetscInt      howoften;  /* when > 0 uses step % howoften, when negative only final solution plotted */
18   PetscBool     showtimestepandtime;
19 };
20 
21 /*@C
22    TSMonitorSetFromOptions - Sets a monitor function and viewer appropriate for the type indicated by the user
23 
24    Collective on TS
25 
26    Input Parameters:
27 +  ts - TS object you wish to monitor
28 .  name - the monitor type one is seeking
29 .  help - message indicating what monitoring is done
30 .  manual - manual page for the monitor
31 .  monitor - the monitor function
32 -  monitorsetup - a function that is called once ONLY if the user selected this monitor that may set additional features of the TS or PetscViewer objects
33 
34    Level: developer
35 
36 .seealso: PetscOptionsGetViewer(), PetscOptionsGetReal(), PetscOptionsHasName(), PetscOptionsGetString(),
37           PetscOptionsGetIntArray(), PetscOptionsGetRealArray(), PetscOptionsBool()
38           PetscOptionsInt(), PetscOptionsString(), PetscOptionsReal(), PetscOptionsBool(),
39           PetscOptionsName(), PetscOptionsBegin(), PetscOptionsEnd(), PetscOptionsHead(),
40           PetscOptionsStringArray(),PetscOptionsRealArray(), PetscOptionsScalar(),
41           PetscOptionsBoolGroupBegin(), PetscOptionsBoolGroup(), PetscOptionsBoolGroupEnd(),
42           PetscOptionsFList(), PetscOptionsEList()
43 @*/
44 PetscErrorCode  TSMonitorSetFromOptions(TS ts,const char name[],const char help[], const char manual[],PetscErrorCode (*monitor)(TS,PetscInt,PetscReal,Vec,PetscViewerAndFormat*),PetscErrorCode (*monitorsetup)(TS,PetscViewerAndFormat*))
45 {
46   PetscErrorCode    ierr;
47   PetscViewer       viewer;
48   PetscViewerFormat format;
49   PetscBool         flg;
50 
51   PetscFunctionBegin;
52   ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)ts),((PetscObject)ts)->prefix,name,&viewer,&format,&flg);CHKERRQ(ierr);
53   if (flg) {
54     PetscViewerAndFormat *vf;
55     ierr = PetscViewerAndFormatCreate(viewer,format,&vf);CHKERRQ(ierr);
56     ierr = PetscObjectDereference((PetscObject)viewer);CHKERRQ(ierr);
57     if (monitorsetup) {
58       ierr = (*monitorsetup)(ts,vf);CHKERRQ(ierr);
59     }
60     ierr = TSMonitorSet(ts,(PetscErrorCode (*)(TS,PetscInt,PetscReal,Vec,void*))monitor,vf,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);CHKERRQ(ierr);
61   }
62   PetscFunctionReturn(0);
63 }
64 
65 /*@C
66    TSAdjointMonitorSensi - monitors the first lambda sensitivity
67 
68    Level: intermediate
69 
70 .keywords: TS, set, monitor
71 
72 .seealso: TSAdjointMonitorSet()
73 @*/
74 PetscErrorCode TSAdjointMonitorSensi(TS ts,PetscInt step,PetscReal ptime,Vec v,PetscInt numcost,Vec *lambda,Vec *mu,PetscViewerAndFormat *vf)
75 {
76   PetscErrorCode ierr;
77   PetscViewer    viewer = vf->viewer;
78 
79   PetscFunctionBegin;
80   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,4);
81   ierr = PetscViewerPushFormat(viewer,vf->format);CHKERRQ(ierr);
82   ierr = VecView(lambda[0],viewer);CHKERRQ(ierr);
83   ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
84   PetscFunctionReturn(0);
85 }
86 
87 /*@C
88    TSAdjointMonitorSetFromOptions - Sets a monitor function and viewer appropriate for the type indicated by the user
89 
90    Collective on TS
91 
92    Input Parameters:
93 +  ts - TS object you wish to monitor
94 .  name - the monitor type one is seeking
95 .  help - message indicating what monitoring is done
96 .  manual - manual page for the monitor
97 .  monitor - the monitor function
98 -  monitorsetup - a function that is called once ONLY if the user selected this monitor that may set additional features of the TS or PetscViewer objects
99 
100    Level: developer
101 
102 .seealso: PetscOptionsGetViewer(), PetscOptionsGetReal(), PetscOptionsHasName(), PetscOptionsGetString(),
103           PetscOptionsGetIntArray(), PetscOptionsGetRealArray(), PetscOptionsBool()
104           PetscOptionsInt(), PetscOptionsString(), PetscOptionsReal(), PetscOptionsBool(),
105           PetscOptionsName(), PetscOptionsBegin(), PetscOptionsEnd(), PetscOptionsHead(),
106           PetscOptionsStringArray(),PetscOptionsRealArray(), PetscOptionsScalar(),
107           PetscOptionsBoolGroupBegin(), PetscOptionsBoolGroup(), PetscOptionsBoolGroupEnd(),
108           PetscOptionsFList(), PetscOptionsEList()
109 @*/
110 PetscErrorCode  TSAdjointMonitorSetFromOptions(TS ts,const char name[],const char help[], const char manual[],PetscErrorCode (*monitor)(TS,PetscInt,PetscReal,Vec,PetscInt,Vec*,Vec*,PetscViewerAndFormat*),PetscErrorCode (*monitorsetup)(TS,PetscViewerAndFormat*))
111 {
112   PetscErrorCode    ierr;
113   PetscViewer       viewer;
114   PetscViewerFormat format;
115   PetscBool         flg;
116 
117   PetscFunctionBegin;
118   ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)ts),((PetscObject)ts)->prefix,name,&viewer,&format,&flg);CHKERRQ(ierr);
119   if (flg) {
120     PetscViewerAndFormat *vf;
121     ierr = PetscViewerAndFormatCreate(viewer,format,&vf);CHKERRQ(ierr);
122     ierr = PetscObjectDereference((PetscObject)viewer);CHKERRQ(ierr);
123     if (monitorsetup) {
124       ierr = (*monitorsetup)(ts,vf);CHKERRQ(ierr);
125     }
126     ierr = TSAdjointMonitorSet(ts,(PetscErrorCode (*)(TS,PetscInt,PetscReal,Vec,PetscInt,Vec*,Vec*,void*))monitor,vf,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);CHKERRQ(ierr);
127   }
128   PetscFunctionReturn(0);
129 }
130 
131 static PetscErrorCode TSAdaptSetDefaultType(TSAdapt adapt,TSAdaptType default_type)
132 {
133   PetscErrorCode ierr;
134 
135   PetscFunctionBegin;
136   PetscValidHeaderSpecific(adapt,TSADAPT_CLASSID,1);
137   PetscValidCharPointer(default_type,2);
138   if (!((PetscObject)adapt)->type_name) {
139     ierr = TSAdaptSetType(adapt,default_type);CHKERRQ(ierr);
140   }
141   PetscFunctionReturn(0);
142 }
143 
144 /*@
145    TSSetFromOptions - Sets various TS parameters from user options.
146 
147    Collective on TS
148 
149    Input Parameter:
150 .  ts - the TS context obtained from TSCreate()
151 
152    Options Database Keys:
153 +  -ts_type <type> - TSEULER, TSBEULER, TSSUNDIALS, TSPSEUDO, TSCN, TSRK, TSTHETA, TSALPHA, TSGLLE, TSSSP, TSGLEE
154 .  -ts_save_trajectory - checkpoint the solution at each time-step
155 .  -ts_max_time <time> - maximum time to compute to
156 .  -ts_max_steps <steps> - maximum number of time-steps to take
157 .  -ts_init_time <time> - initial time to start computation
158 .  -ts_final_time <time> - final time to compute to
159 .  -ts_dt <dt> - initial time step
160 .  -ts_exact_final_time <stepover,interpolate,matchstep> whether to stop at the exact given final time and how to compute the solution at that ti,e
161 .  -ts_max_snes_failures <maxfailures> - Maximum number of nonlinear solve failures allowed
162 .  -ts_max_reject <maxrejects> - Maximum number of step rejections before step fails
163 .  -ts_error_if_step_fails <true,false> - Error if no step succeeds
164 .  -ts_rtol <rtol> - relative tolerance for local truncation error
165 .  -ts_atol <atol> Absolute tolerance for local truncation error
166 .  -ts_rhs_jacobian_test_mult -mat_shell_test_mult_view - test the Jacobian at each iteration against finite difference with RHS function
167 .  -ts_rhs_jacobian_test_mult_transpose -mat_shell_test_mult_transpose_view - test the Jacobian at each iteration against finite difference with RHS function
168 .  -ts_adjoint_solve <yes,no> After solving the ODE/DAE solve the adjoint problem (requires -ts_save_trajectory)
169 .  -ts_fd_color - Use finite differences with coloring to compute IJacobian
170 .  -ts_monitor - print information at each timestep
171 .  -ts_monitor_lg_solution - Monitor solution graphically
172 .  -ts_monitor_lg_error - Monitor error graphically
173 .  -ts_monitor_error - Monitors norm of error
174 .  -ts_monitor_lg_timestep - Monitor timestep size graphically
175 .  -ts_monitor_lg_timestep_log - Monitor log timestep size graphically
176 .  -ts_monitor_lg_snes_iterations - Monitor number nonlinear iterations for each timestep graphically
177 .  -ts_monitor_lg_ksp_iterations - Monitor number nonlinear iterations for each timestep graphically
178 .  -ts_monitor_sp_eig - Monitor eigenvalues of linearized operator graphically
179 .  -ts_monitor_draw_solution - Monitor solution graphically
180 .  -ts_monitor_draw_solution_phase  <xleft,yleft,xright,yright> - Monitor solution graphically with phase diagram, requires problem with exactly 2 degrees of freedom
181 .  -ts_monitor_draw_error - Monitor error graphically, requires use to have provided TSSetSolutionFunction()
182 .  -ts_monitor_solution [ascii binary draw][:filename][:viewerformat] - monitors the solution at each timestep
183 .  -ts_monitor_solution_vtk <filename.vts,filename.vtu> - Save each time step to a binary file, use filename-%%03D.vts (filename-%%03D.vtu)
184 .  -ts_monitor_envelope - determine maximum and minimum value of each component of the solution over the solution time
185 .  -ts_adjoint_monitor - print information at each adjoint time step
186 -  -ts_adjoint_monitor_draw_sensi - monitor the sensitivity of the first cost function wrt initial conditions (lambda[0]) graphically
187 
188    Developer Note: We should unify all the -ts_monitor options in the way that -xxx_view has been unified
189 
190    Level: beginner
191 
192 .keywords: TS, timestep, set, options, database
193 
194 .seealso: TSGetType()
195 @*/
196 PetscErrorCode  TSSetFromOptions(TS ts)
197 {
198   PetscBool              opt,flg,tflg;
199   PetscErrorCode         ierr;
200   char                   monfilename[PETSC_MAX_PATH_LEN];
201   PetscReal              time_step;
202   TSExactFinalTimeOption eftopt;
203   char                   dir[16];
204   TSIFunction            ifun;
205   const char             *defaultType;
206   char                   typeName[256];
207 
208   PetscFunctionBegin;
209   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
210 
211   ierr = TSRegisterAll();CHKERRQ(ierr);
212   ierr = TSGetIFunction(ts,NULL,&ifun,NULL);CHKERRQ(ierr);
213 
214   ierr = PetscObjectOptionsBegin((PetscObject)ts);CHKERRQ(ierr);
215   if (((PetscObject)ts)->type_name)
216     defaultType = ((PetscObject)ts)->type_name;
217   else
218     defaultType = ifun ? TSBEULER : TSEULER;
219   ierr = PetscOptionsFList("-ts_type","TS method","TSSetType",TSList,defaultType,typeName,256,&opt);CHKERRQ(ierr);
220   if (opt) {
221     ierr = TSSetType(ts,typeName);CHKERRQ(ierr);
222   } else {
223     ierr = TSSetType(ts,defaultType);CHKERRQ(ierr);
224   }
225 
226   /* Handle generic TS options */
227   ierr = PetscOptionsReal("-ts_max_time","Maximum time to run to","TSSetMaxTime",ts->max_time,&ts->max_time,NULL);CHKERRQ(ierr);
228   ierr = PetscOptionsInt("-ts_max_steps","Maximum number of time steps","TSSetMaxSteps",ts->max_steps,&ts->max_steps,NULL);CHKERRQ(ierr);
229   ierr = PetscOptionsReal("-ts_init_time","Initial time","TSSetTime",ts->ptime,&ts->ptime,NULL);CHKERRQ(ierr);
230   ierr = PetscOptionsReal("-ts_final_time","Final time to run to","TSSetMaxTime",ts->max_time,&ts->max_time,NULL);CHKERRQ(ierr);
231   ierr = PetscOptionsReal("-ts_dt","Initial time step","TSSetTimeStep",ts->time_step,&time_step,&flg);CHKERRQ(ierr);
232   if (flg) {ierr = TSSetTimeStep(ts,time_step);CHKERRQ(ierr);}
233   ierr = PetscOptionsEnum("-ts_exact_final_time","Option for handling of final time step","TSSetExactFinalTime",TSExactFinalTimeOptions,(PetscEnum)ts->exact_final_time,(PetscEnum*)&eftopt,&flg);CHKERRQ(ierr);
234   if (flg) {ierr = TSSetExactFinalTime(ts,eftopt);CHKERRQ(ierr);}
235   ierr = PetscOptionsInt("-ts_max_snes_failures","Maximum number of nonlinear solve failures","TSSetMaxSNESFailures",ts->max_snes_failures,&ts->max_snes_failures,NULL);CHKERRQ(ierr);
236   ierr = PetscOptionsInt("-ts_max_reject","Maximum number of step rejections before step fails","TSSetMaxStepRejections",ts->max_reject,&ts->max_reject,NULL);CHKERRQ(ierr);
237   ierr = PetscOptionsBool("-ts_error_if_step_fails","Error if no step succeeds","TSSetErrorIfStepFails",ts->errorifstepfailed,&ts->errorifstepfailed,NULL);CHKERRQ(ierr);
238   ierr = PetscOptionsReal("-ts_rtol","Relative tolerance for local truncation error","TSSetTolerances",ts->rtol,&ts->rtol,NULL);CHKERRQ(ierr);
239   ierr = PetscOptionsReal("-ts_atol","Absolute tolerance for local truncation error","TSSetTolerances",ts->atol,&ts->atol,NULL);CHKERRQ(ierr);
240 
241   ierr = PetscOptionsBool("-ts_rhs_jacobian_test_mult","Test the RHS Jacobian for consistency with RHS at each solve ","None",ts->testjacobian,&ts->testjacobian,NULL);CHKERRQ(ierr);
242   ierr = PetscOptionsBool("-ts_rhs_jacobian_test_mult_transpose","Test the RHS Jacobian transpose for consistency with RHS at each solve ","None",ts->testjacobiantranspose,&ts->testjacobiantranspose,NULL);CHKERRQ(ierr);
243 #if defined(PETSC_HAVE_SAWS)
244   {
245   PetscBool set;
246   flg  = PETSC_FALSE;
247   ierr = PetscOptionsBool("-ts_saws_block","Block for SAWs memory snooper at end of TSSolve","PetscObjectSAWsBlock",((PetscObject)ts)->amspublishblock,&flg,&set);CHKERRQ(ierr);
248   if (set) {
249     ierr = PetscObjectSAWsSetBlock((PetscObject)ts,flg);CHKERRQ(ierr);
250   }
251   }
252 #endif
253 
254   /* Monitor options */
255   ierr = TSMonitorSetFromOptions(ts,"-ts_monitor","Monitor time and timestep size","TSMonitorDefault",TSMonitorDefault,NULL);CHKERRQ(ierr);
256   ierr = TSMonitorSetFromOptions(ts,"-ts_monitor_solution","View the solution at each timestep","TSMonitorSolution",TSMonitorSolution,NULL);CHKERRQ(ierr);
257   ierr = TSAdjointMonitorSetFromOptions(ts,"-ts_adjoint_monitor","Monitor adjoint timestep size","TSAdjointMonitorDefault",TSAdjointMonitorDefault,NULL);CHKERRQ(ierr);
258   ierr = TSAdjointMonitorSetFromOptions(ts,"-ts_adjoint_monitor_sensi","Monitor sensitivity in the adjoint computation","TSAdjointMonitorSensi",TSAdjointMonitorSensi,NULL);CHKERRQ(ierr);
259 
260   ierr = PetscOptionsString("-ts_monitor_python","Use Python function","TSMonitorSet",0,monfilename,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
261   if (flg) {ierr = PetscPythonMonitorSet((PetscObject)ts,monfilename);CHKERRQ(ierr);}
262 
263   ierr = PetscOptionsName("-ts_monitor_lg_solution","Monitor solution graphically","TSMonitorLGSolution",&opt);CHKERRQ(ierr);
264   if (opt) {
265     TSMonitorLGCtx ctx;
266     PetscInt       howoften = 1;
267 
268     ierr = PetscOptionsInt("-ts_monitor_lg_solution","Monitor solution graphically","TSMonitorLGSolution",howoften,&howoften,NULL);CHKERRQ(ierr);
269     ierr = TSMonitorLGCtxCreate(PETSC_COMM_SELF,0,0,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
270     ierr = TSMonitorSet(ts,TSMonitorLGSolution,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
271   }
272 
273   ierr = PetscOptionsName("-ts_monitor_lg_error","Monitor error graphically","TSMonitorLGError",&opt);CHKERRQ(ierr);
274   if (opt) {
275     TSMonitorLGCtx ctx;
276     PetscInt       howoften = 1;
277 
278     ierr = PetscOptionsInt("-ts_monitor_lg_error","Monitor error graphically","TSMonitorLGError",howoften,&howoften,NULL);CHKERRQ(ierr);
279     ierr = TSMonitorLGCtxCreate(PETSC_COMM_SELF,0,0,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
280     ierr = TSMonitorSet(ts,TSMonitorLGError,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
281   }
282   ierr = TSMonitorSetFromOptions(ts,"-ts_monitor_error","View the error at each timestep","TSMonitorError",TSMonitorError,NULL);CHKERRQ(ierr);
283 
284   ierr = PetscOptionsName("-ts_monitor_lg_timestep","Monitor timestep size graphically","TSMonitorLGTimeStep",&opt);CHKERRQ(ierr);
285   if (opt) {
286     TSMonitorLGCtx ctx;
287     PetscInt       howoften = 1;
288 
289     ierr = PetscOptionsInt("-ts_monitor_lg_timestep","Monitor timestep size graphically","TSMonitorLGTimeStep",howoften,&howoften,NULL);CHKERRQ(ierr);
290     ierr = TSMonitorLGCtxCreate(PetscObjectComm((PetscObject)ts),NULL,NULL,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
291     ierr = TSMonitorSet(ts,TSMonitorLGTimeStep,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
292   }
293   ierr = PetscOptionsName("-ts_monitor_lg_timestep_log","Monitor log timestep size graphically","TSMonitorLGTimeStep",&opt);CHKERRQ(ierr);
294   if (opt) {
295     TSMonitorLGCtx ctx;
296     PetscInt       howoften = 1;
297 
298     ierr = PetscOptionsInt("-ts_monitor_lg_timestep_log","Monitor log timestep size graphically","TSMonitorLGTimeStep",howoften,&howoften,NULL);CHKERRQ(ierr);
299     ierr = TSMonitorLGCtxCreate(PetscObjectComm((PetscObject)ts),NULL,NULL,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
300     ierr = TSMonitorSet(ts,TSMonitorLGTimeStep,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
301     ctx->semilogy = PETSC_TRUE;
302   }
303 
304   ierr = PetscOptionsName("-ts_monitor_lg_snes_iterations","Monitor number nonlinear iterations for each timestep graphically","TSMonitorLGSNESIterations",&opt);CHKERRQ(ierr);
305   if (opt) {
306     TSMonitorLGCtx ctx;
307     PetscInt       howoften = 1;
308 
309     ierr = PetscOptionsInt("-ts_monitor_lg_snes_iterations","Monitor number nonlinear iterations for each timestep graphically","TSMonitorLGSNESIterations",howoften,&howoften,NULL);CHKERRQ(ierr);
310     ierr = TSMonitorLGCtxCreate(PetscObjectComm((PetscObject)ts),NULL,NULL,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
311     ierr = TSMonitorSet(ts,TSMonitorLGSNESIterations,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
312   }
313   ierr = PetscOptionsName("-ts_monitor_lg_ksp_iterations","Monitor number nonlinear iterations for each timestep graphically","TSMonitorLGKSPIterations",&opt);CHKERRQ(ierr);
314   if (opt) {
315     TSMonitorLGCtx ctx;
316     PetscInt       howoften = 1;
317 
318     ierr = PetscOptionsInt("-ts_monitor_lg_ksp_iterations","Monitor number nonlinear iterations for each timestep graphically","TSMonitorLGKSPIterations",howoften,&howoften,NULL);CHKERRQ(ierr);
319     ierr = TSMonitorLGCtxCreate(PetscObjectComm((PetscObject)ts),NULL,NULL,PETSC_DECIDE,PETSC_DECIDE,400,300,howoften,&ctx);CHKERRQ(ierr);
320     ierr = TSMonitorSet(ts,TSMonitorLGKSPIterations,ctx,(PetscErrorCode (*)(void**))TSMonitorLGCtxDestroy);CHKERRQ(ierr);
321   }
322   ierr = PetscOptionsName("-ts_monitor_sp_eig","Monitor eigenvalues of linearized operator graphically","TSMonitorSPEig",&opt);CHKERRQ(ierr);
323   if (opt) {
324     TSMonitorSPEigCtx ctx;
325     PetscInt          howoften = 1;
326 
327     ierr = PetscOptionsInt("-ts_monitor_sp_eig","Monitor eigenvalues of linearized operator graphically","TSMonitorSPEig",howoften,&howoften,NULL);CHKERRQ(ierr);
328     ierr = TSMonitorSPEigCtxCreate(PETSC_COMM_SELF,0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,howoften,&ctx);CHKERRQ(ierr);
329     ierr = TSMonitorSet(ts,TSMonitorSPEig,ctx,(PetscErrorCode (*)(void**))TSMonitorSPEigCtxDestroy);CHKERRQ(ierr);
330   }
331   opt  = PETSC_FALSE;
332   ierr = PetscOptionsName("-ts_monitor_draw_solution","Monitor solution graphically","TSMonitorDrawSolution",&opt);CHKERRQ(ierr);
333   if (opt) {
334     TSMonitorDrawCtx ctx;
335     PetscInt         howoften = 1;
336 
337     ierr = PetscOptionsInt("-ts_monitor_draw_solution","Monitor solution graphically","TSMonitorDrawSolution",howoften,&howoften,NULL);CHKERRQ(ierr);
338     ierr = TSMonitorDrawCtxCreate(PetscObjectComm((PetscObject)ts),0,"Computed Solution",PETSC_DECIDE,PETSC_DECIDE,300,300,howoften,&ctx);CHKERRQ(ierr);
339     ierr = TSMonitorSet(ts,TSMonitorDrawSolution,ctx,(PetscErrorCode (*)(void**))TSMonitorDrawCtxDestroy);CHKERRQ(ierr);
340   }
341   opt  = PETSC_FALSE;
342   ierr = PetscOptionsName("-ts_adjoint_monitor_draw_sensi","Monitor adjoint sensitivities (lambda only) graphically","TSAdjointMonitorDrawSensi",&opt);CHKERRQ(ierr);
343   if (opt) {
344     TSMonitorDrawCtx ctx;
345     PetscInt         howoften = 1;
346 
347     ierr = PetscOptionsInt("-ts_adjoint_monitor_draw_sensi","Monitor adjoint sensitivities (lambda only) graphically","TSAdjointMonitorDrawSensi",howoften,&howoften,NULL);CHKERRQ(ierr);
348     ierr = TSMonitorDrawCtxCreate(PetscObjectComm((PetscObject)ts),0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,howoften,&ctx);CHKERRQ(ierr);
349     ierr = TSAdjointMonitorSet(ts,TSAdjointMonitorDrawSensi,ctx,(PetscErrorCode (*)(void**))TSMonitorDrawCtxDestroy);CHKERRQ(ierr);
350   }
351   opt  = PETSC_FALSE;
352   ierr = PetscOptionsName("-ts_monitor_draw_solution_phase","Monitor solution graphically","TSMonitorDrawSolutionPhase",&opt);CHKERRQ(ierr);
353   if (opt) {
354     TSMonitorDrawCtx ctx;
355     PetscReal        bounds[4];
356     PetscInt         n = 4;
357     PetscDraw        draw;
358     PetscDrawAxis    axis;
359 
360     ierr = PetscOptionsRealArray("-ts_monitor_draw_solution_phase","Monitor solution graphically","TSMonitorDrawSolutionPhase",bounds,&n,NULL);CHKERRQ(ierr);
361     if (n != 4) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONG,"Must provide bounding box of phase field");
362     ierr = TSMonitorDrawCtxCreate(PetscObjectComm((PetscObject)ts),0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,1,&ctx);CHKERRQ(ierr);
363     ierr = PetscViewerDrawGetDraw(ctx->viewer,0,&draw);CHKERRQ(ierr);
364     ierr = PetscViewerDrawGetDrawAxis(ctx->viewer,0,&axis);CHKERRQ(ierr);
365     ierr = PetscDrawAxisSetLimits(axis,bounds[0],bounds[2],bounds[1],bounds[3]);CHKERRQ(ierr);
366     ierr = PetscDrawAxisSetLabels(axis,"Phase Diagram","Variable 1","Variable 2");CHKERRQ(ierr);
367     ierr = TSMonitorSet(ts,TSMonitorDrawSolutionPhase,ctx,(PetscErrorCode (*)(void**))TSMonitorDrawCtxDestroy);CHKERRQ(ierr);
368   }
369   opt  = PETSC_FALSE;
370   ierr = PetscOptionsName("-ts_monitor_draw_error","Monitor error graphically","TSMonitorDrawError",&opt);CHKERRQ(ierr);
371   if (opt) {
372     TSMonitorDrawCtx ctx;
373     PetscInt         howoften = 1;
374 
375     ierr = PetscOptionsInt("-ts_monitor_draw_error","Monitor error graphically","TSMonitorDrawError",howoften,&howoften,NULL);CHKERRQ(ierr);
376     ierr = TSMonitorDrawCtxCreate(PetscObjectComm((PetscObject)ts),0,"Error",PETSC_DECIDE,PETSC_DECIDE,300,300,howoften,&ctx);CHKERRQ(ierr);
377     ierr = TSMonitorSet(ts,TSMonitorDrawError,ctx,(PetscErrorCode (*)(void**))TSMonitorDrawCtxDestroy);CHKERRQ(ierr);
378   }
379   opt  = PETSC_FALSE;
380   ierr = PetscOptionsName("-ts_monitor_draw_solution_function","Monitor solution provided by TSMonitorSetSolutionFunction() graphically","TSMonitorDrawSolutionFunction",&opt);CHKERRQ(ierr);
381   if (opt) {
382     TSMonitorDrawCtx ctx;
383     PetscInt         howoften = 1;
384 
385     ierr = PetscOptionsInt("-ts_monitor_draw_solution_function","Monitor solution provided by TSMonitorSetSolutionFunction() graphically","TSMonitorDrawSolutionFunction",howoften,&howoften,NULL);CHKERRQ(ierr);
386     ierr = TSMonitorDrawCtxCreate(PetscObjectComm((PetscObject)ts),0,"Solution provided by user function",PETSC_DECIDE,PETSC_DECIDE,300,300,howoften,&ctx);CHKERRQ(ierr);
387     ierr = TSMonitorSet(ts,TSMonitorDrawSolutionFunction,ctx,(PetscErrorCode (*)(void**))TSMonitorDrawCtxDestroy);CHKERRQ(ierr);
388   }
389 
390   opt  = PETSC_FALSE;
391   ierr = PetscOptionsString("-ts_monitor_solution_vtk","Save each time step to a binary file, use filename-%%03D.vts","TSMonitorSolutionVTK",0,monfilename,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
392   if (flg) {
393     const char *ptr,*ptr2;
394     char       *filetemplate;
395     if (!monfilename[0]) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"-ts_monitor_solution_vtk requires a file template, e.g. filename-%%03D.vts");
396     /* Do some cursory validation of the input. */
397     ierr = PetscStrstr(monfilename,"%",(char**)&ptr);CHKERRQ(ierr);
398     if (!ptr) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"-ts_monitor_solution_vtk requires a file template, e.g. filename-%%03D.vts");
399     for (ptr++; ptr && *ptr; ptr++) {
400       ierr = PetscStrchr("DdiouxX",*ptr,(char**)&ptr2);CHKERRQ(ierr);
401       if (!ptr2 && (*ptr < '0' || '9' < *ptr)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"Invalid file template argument to -ts_monitor_solution_vtk, should look like filename-%%03D.vts");
402       if (ptr2) break;
403     }
404     ierr = PetscStrallocpy(monfilename,&filetemplate);CHKERRQ(ierr);
405     ierr = TSMonitorSet(ts,TSMonitorSolutionVTK,filetemplate,(PetscErrorCode (*)(void**))TSMonitorSolutionVTKDestroy);CHKERRQ(ierr);
406   }
407 
408   ierr = PetscOptionsString("-ts_monitor_dmda_ray","Display a ray of the solution","None","y=0",dir,16,&flg);CHKERRQ(ierr);
409   if (flg) {
410     TSMonitorDMDARayCtx *rayctx;
411     int                  ray = 0;
412     DMDADirection        ddir;
413     DM                   da;
414     PetscMPIInt          rank;
415 
416     if (dir[1] != '=') SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONG,"Unknown ray %s",dir);
417     if (dir[0] == 'x') ddir = DMDA_X;
418     else if (dir[0] == 'y') ddir = DMDA_Y;
419     else SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONG,"Unknown ray %s",dir);
420     sscanf(dir+2,"%d",&ray);
421 
422     ierr = PetscInfo2(((PetscObject)ts),"Displaying DMDA ray %c = %D\n",dir[0],ray);CHKERRQ(ierr);
423     ierr = PetscNew(&rayctx);CHKERRQ(ierr);
424     ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
425     ierr = DMDAGetRay(da,ddir,ray,&rayctx->ray,&rayctx->scatter);CHKERRQ(ierr);
426     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)ts),&rank);CHKERRQ(ierr);
427     if (!rank) {
428       ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,0,0,0,600,300,&rayctx->viewer);CHKERRQ(ierr);
429     }
430     rayctx->lgctx = NULL;
431     ierr = TSMonitorSet(ts,TSMonitorDMDARay,rayctx,TSMonitorDMDARayDestroy);CHKERRQ(ierr);
432   }
433   ierr = PetscOptionsString("-ts_monitor_lg_dmda_ray","Display a ray of the solution","None","x=0",dir,16,&flg);CHKERRQ(ierr);
434   if (flg) {
435     TSMonitorDMDARayCtx *rayctx;
436     int                 ray = 0;
437     DMDADirection       ddir;
438     DM                  da;
439     PetscInt            howoften = 1;
440 
441     if (dir[1] != '=') SETERRQ1(PetscObjectComm((PetscObject) ts), PETSC_ERR_ARG_WRONG, "Malformed ray %s", dir);
442     if      (dir[0] == 'x') ddir = DMDA_X;
443     else if (dir[0] == 'y') ddir = DMDA_Y;
444     else SETERRQ1(PetscObjectComm((PetscObject) ts), PETSC_ERR_ARG_WRONG, "Unknown ray direction %s", dir);
445     sscanf(dir+2, "%d", &ray);
446 
447     ierr = PetscInfo2(((PetscObject) ts),"Displaying LG DMDA ray %c = %D\n", dir[0], ray);CHKERRQ(ierr);
448     ierr = PetscNew(&rayctx);CHKERRQ(ierr);
449     ierr = TSGetDM(ts, &da);CHKERRQ(ierr);
450     ierr = DMDAGetRay(da, ddir, ray, &rayctx->ray, &rayctx->scatter);CHKERRQ(ierr);
451     ierr = TSMonitorLGCtxCreate(PETSC_COMM_SELF,0,0,PETSC_DECIDE,PETSC_DECIDE,600,400,howoften,&rayctx->lgctx);CHKERRQ(ierr);
452     ierr = TSMonitorSet(ts, TSMonitorLGDMDARay, rayctx, TSMonitorDMDARayDestroy);CHKERRQ(ierr);
453   }
454 
455   ierr = PetscOptionsName("-ts_monitor_envelope","Monitor maximum and minimum value of each component of the solution","TSMonitorEnvelope",&opt);CHKERRQ(ierr);
456   if (opt) {
457     TSMonitorEnvelopeCtx ctx;
458 
459     ierr = TSMonitorEnvelopeCtxCreate(ts,&ctx);CHKERRQ(ierr);
460     ierr = TSMonitorSet(ts,TSMonitorEnvelope,ctx,(PetscErrorCode (*)(void**))TSMonitorEnvelopeCtxDestroy);CHKERRQ(ierr);
461   }
462 
463   flg  = PETSC_FALSE;
464   ierr = PetscOptionsBool("-ts_fd_color", "Use finite differences with coloring to compute IJacobian", "TSComputeJacobianDefaultColor", flg, &flg, NULL);CHKERRQ(ierr);
465   if (flg) {
466     DM   dm;
467     DMTS tdm;
468 
469     ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
470     ierr = DMGetDMTS(dm, &tdm);CHKERRQ(ierr);
471     tdm->ijacobianctx = NULL;
472     ierr = TSSetIJacobian(ts, NULL, NULL, TSComputeIJacobianDefaultColor, 0);CHKERRQ(ierr);
473     ierr = PetscInfo(ts, "Setting default finite difference coloring Jacobian matrix\n");CHKERRQ(ierr);
474   }
475 
476   /* Handle specific TS options */
477   if (ts->ops->setfromoptions) {
478     ierr = (*ts->ops->setfromoptions)(PetscOptionsObject,ts);CHKERRQ(ierr);
479   }
480 
481   /* Handle TSAdapt options */
482   ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
483   ierr = TSAdaptSetDefaultType(ts->adapt,ts->default_adapt_type);CHKERRQ(ierr);
484   ierr = TSAdaptSetFromOptions(PetscOptionsObject,ts->adapt);CHKERRQ(ierr);
485 
486   /* TS trajectory must be set after TS, since it may use some TS options above */
487   tflg = ts->trajectory ? PETSC_TRUE : PETSC_FALSE;
488   ierr = PetscOptionsBool("-ts_save_trajectory","Save the solution at each timestep","TSSetSaveTrajectory",tflg,&tflg,NULL);CHKERRQ(ierr);
489   if (tflg) {
490     ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
491   }
492   tflg = ts->adjoint_solve ? PETSC_TRUE : PETSC_FALSE;
493   ierr = PetscOptionsBool("-ts_adjoint_solve","Solve the adjoint problem immediately after solving the forward problem","",tflg,&tflg,&flg);CHKERRQ(ierr);
494   if (flg) {
495     ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
496     ts->adjoint_solve = tflg;
497   }
498 
499   /* process any options handlers added with PetscObjectAddOptionsHandler() */
500   ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)ts);CHKERRQ(ierr);
501   ierr = PetscOptionsEnd();CHKERRQ(ierr);
502 
503   if (ts->trajectory) {
504     ierr = TSTrajectorySetFromOptions(ts->trajectory,ts);CHKERRQ(ierr);
505   }
506 
507   ierr = TSGetSNES(ts,&ts->snes);CHKERRQ(ierr);
508   if (ts->problem_type == TS_LINEAR) {ierr = SNESSetType(ts->snes,SNESKSPONLY);CHKERRQ(ierr);}
509   ierr = SNESSetFromOptions(ts->snes);CHKERRQ(ierr);
510   PetscFunctionReturn(0);
511 }
512 
513 /*@
514    TSGetTrajectory - Gets the trajectory from a TS if it exists
515 
516    Collective on TS
517 
518    Input Parameters:
519 .  ts - the TS context obtained from TSCreate()
520 
521    Output Parameters;
522 .  tr - the TSTrajectory object, if it exists
523 
524    Note: This routine should be called after all TS options have been set
525 
526    Level: advanced
527 
528 .seealso: TSGetTrajectory(), TSAdjointSolve(), TSTrajectory, TSTrajectoryCreate()
529 
530 .keywords: TS, set, checkpoint,
531 @*/
532 PetscErrorCode  TSGetTrajectory(TS ts,TSTrajectory *tr)
533 {
534   PetscFunctionBegin;
535   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
536   *tr = ts->trajectory;
537   PetscFunctionReturn(0);
538 }
539 
540 /*@
541    TSSetSaveTrajectory - Causes the TS to save its solutions as it iterates forward in time in a TSTrajectory object
542 
543    Collective on TS
544 
545    Input Parameters:
546 .  ts - the TS context obtained from TSCreate()
547 
548    Options Database:
549 +  -ts_save_trajectory - saves the trajectory to a file
550 -  -ts_trajectory_type type
551 
552 Note: This routine should be called after all TS options have been set
553 
554     The TSTRAJECTORYVISUALIZATION files can be loaded into Python with $PETSC_DIR/lib/petsc/bin/PetscBinaryIOTrajectory.py and
555    MATLAB with $PETSC_DIR/share/petsc/matlab/PetscReadBinaryTrajectory.m
556 
557    Level: intermediate
558 
559 .seealso: TSGetTrajectory(), TSAdjointSolve(), TSTrajectoryType, TSSetTrajectoryType()
560 
561 .keywords: TS, set, checkpoint,
562 @*/
563 PetscErrorCode  TSSetSaveTrajectory(TS ts)
564 {
565   PetscErrorCode ierr;
566 
567   PetscFunctionBegin;
568   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
569   if (!ts->trajectory) {
570     ierr = TSTrajectoryCreate(PetscObjectComm((PetscObject)ts),&ts->trajectory);CHKERRQ(ierr);
571   }
572   PetscFunctionReturn(0);
573 }
574 
575 /*@
576    TSComputeRHSJacobian - Computes the Jacobian matrix that has been
577       set with TSSetRHSJacobian().
578 
579    Collective on TS and Vec
580 
581    Input Parameters:
582 +  ts - the TS context
583 .  t - current timestep
584 -  U - input vector
585 
586    Output Parameters:
587 +  A - Jacobian matrix
588 .  B - optional preconditioning matrix
589 -  flag - flag indicating matrix structure
590 
591    Notes:
592    Most users should not need to explicitly call this routine, as it
593    is used internally within the nonlinear solvers.
594 
595    See KSPSetOperators() for important information about setting the
596    flag parameter.
597 
598    Level: developer
599 
600 .keywords: SNES, compute, Jacobian, matrix
601 
602 .seealso:  TSSetRHSJacobian(), KSPSetOperators()
603 @*/
604 PetscErrorCode  TSComputeRHSJacobian(TS ts,PetscReal t,Vec U,Mat A,Mat B)
605 {
606   PetscErrorCode   ierr;
607   PetscObjectState Ustate;
608   PetscObjectId    Uid;
609   DM               dm;
610   DMTS             tsdm;
611   TSRHSJacobian    rhsjacobianfunc;
612   void             *ctx;
613   TSIJacobian      ijacobianfunc;
614   TSRHSFunction    rhsfunction;
615 
616   PetscFunctionBegin;
617   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
618   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
619   PetscCheckSameComm(ts,1,U,3);
620   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
621   ierr = DMGetDMTS(dm,&tsdm);CHKERRQ(ierr);
622   ierr = DMTSGetRHSJacobian(dm,&rhsjacobianfunc,&ctx);CHKERRQ(ierr);
623   ierr = DMTSGetIJacobian(dm,&ijacobianfunc,NULL);CHKERRQ(ierr);
624   ierr = DMTSGetRHSFunction(dm,&rhsfunction,&ctx);CHKERRQ(ierr);
625   ierr = PetscObjectStateGet((PetscObject)U,&Ustate);CHKERRQ(ierr);
626   ierr = PetscObjectGetId((PetscObject)U,&Uid);CHKERRQ(ierr);
627   if (ts->rhsjacobian.time == t && (ts->problem_type == TS_LINEAR || (ts->rhsjacobian.Xid == Uid && ts->rhsjacobian.Xstate == Ustate)) && (rhsfunction != TSComputeRHSFunctionLinear)) {
628     PetscFunctionReturn(0);
629   }
630 
631   if (!rhsjacobianfunc && !ijacobianfunc) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"Must call TSSetRHSJacobian() and / or TSSetIJacobian()");
632 
633   if (ts->rhsjacobian.reuse) {
634     ierr = MatShift(A,-ts->rhsjacobian.shift);CHKERRQ(ierr);
635     ierr = MatScale(A,1./ts->rhsjacobian.scale);CHKERRQ(ierr);
636     if (B && A != B) {
637       ierr = MatShift(B,-ts->rhsjacobian.shift);CHKERRQ(ierr);
638       ierr = MatScale(B,1./ts->rhsjacobian.scale);CHKERRQ(ierr);
639     }
640     ts->rhsjacobian.shift = 0;
641     ts->rhsjacobian.scale = 1.;
642   }
643 
644   if (rhsjacobianfunc) {
645     PetscBool missing;
646     ierr = PetscLogEventBegin(TS_JacobianEval,ts,U,A,B);CHKERRQ(ierr);
647     PetscStackPush("TS user Jacobian function");
648     ierr = (*rhsjacobianfunc)(ts,t,U,A,B,ctx);CHKERRQ(ierr);
649     PetscStackPop;
650     ierr = PetscLogEventEnd(TS_JacobianEval,ts,U,A,B);CHKERRQ(ierr);
651     if (A) {
652       ierr = MatMissingDiagonal(A,&missing,NULL);CHKERRQ(ierr);
653       if (missing) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Amat passed to TSSetRHSJacobian() must have all diagonal entries set, if they are zero you must still set them with a zero value");
654     }
655     if (B && B != A) {
656       ierr = MatMissingDiagonal(B,&missing,NULL);CHKERRQ(ierr);
657       if (missing) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Bmat passed to TSSetRHSJacobian() must have all diagonal entries set, if they are zero you must still set them with a zero value");
658     }
659   } else {
660     ierr = MatZeroEntries(A);CHKERRQ(ierr);
661     if (A != B) {ierr = MatZeroEntries(B);CHKERRQ(ierr);}
662   }
663   ts->rhsjacobian.time       = t;
664   ierr                       = PetscObjectGetId((PetscObject)U,&ts->rhsjacobian.Xid);CHKERRQ(ierr);
665   ierr                       = PetscObjectStateGet((PetscObject)U,&ts->rhsjacobian.Xstate);CHKERRQ(ierr);
666   PetscFunctionReturn(0);
667 }
668 
669 /*@
670    TSComputeRHSFunction - Evaluates the right-hand-side function.
671 
672    Collective on TS and Vec
673 
674    Input Parameters:
675 +  ts - the TS context
676 .  t - current time
677 -  U - state vector
678 
679    Output Parameter:
680 .  y - right hand side
681 
682    Note:
683    Most users should not need to explicitly call this routine, as it
684    is used internally within the nonlinear solvers.
685 
686    Level: developer
687 
688 .keywords: TS, compute
689 
690 .seealso: TSSetRHSFunction(), TSComputeIFunction()
691 @*/
692 PetscErrorCode TSComputeRHSFunction(TS ts,PetscReal t,Vec U,Vec y)
693 {
694   PetscErrorCode ierr;
695   TSRHSFunction  rhsfunction;
696   TSIFunction    ifunction;
697   void           *ctx;
698   DM             dm;
699 
700   PetscFunctionBegin;
701   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
702   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
703   PetscValidHeaderSpecific(y,VEC_CLASSID,4);
704   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
705   ierr = DMTSGetRHSFunction(dm,&rhsfunction,&ctx);CHKERRQ(ierr);
706   ierr = DMTSGetIFunction(dm,&ifunction,NULL);CHKERRQ(ierr);
707 
708   if (!rhsfunction && !ifunction) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"Must call TSSetRHSFunction() and / or TSSetIFunction()");
709 
710   ierr = PetscLogEventBegin(TS_FunctionEval,ts,U,y,0);CHKERRQ(ierr);
711   if (rhsfunction) {
712     PetscStackPush("TS user right-hand-side function");
713     ierr = (*rhsfunction)(ts,t,U,y,ctx);CHKERRQ(ierr);
714     PetscStackPop;
715   } else {
716     ierr = VecZeroEntries(y);CHKERRQ(ierr);
717   }
718 
719   ierr = PetscLogEventEnd(TS_FunctionEval,ts,U,y,0);CHKERRQ(ierr);
720   PetscFunctionReturn(0);
721 }
722 
723 /*@
724    TSComputeSolutionFunction - Evaluates the solution function.
725 
726    Collective on TS and Vec
727 
728    Input Parameters:
729 +  ts - the TS context
730 -  t - current time
731 
732    Output Parameter:
733 .  U - the solution
734 
735    Note:
736    Most users should not need to explicitly call this routine, as it
737    is used internally within the nonlinear solvers.
738 
739    Level: developer
740 
741 .keywords: TS, compute
742 
743 .seealso: TSSetSolutionFunction(), TSSetRHSFunction(), TSComputeIFunction()
744 @*/
745 PetscErrorCode TSComputeSolutionFunction(TS ts,PetscReal t,Vec U)
746 {
747   PetscErrorCode     ierr;
748   TSSolutionFunction solutionfunction;
749   void               *ctx;
750   DM                 dm;
751 
752   PetscFunctionBegin;
753   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
754   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
755   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
756   ierr = DMTSGetSolutionFunction(dm,&solutionfunction,&ctx);CHKERRQ(ierr);
757 
758   if (solutionfunction) {
759     PetscStackPush("TS user solution function");
760     ierr = (*solutionfunction)(ts,t,U,ctx);CHKERRQ(ierr);
761     PetscStackPop;
762   }
763   PetscFunctionReturn(0);
764 }
765 /*@
766    TSComputeForcingFunction - Evaluates the forcing function.
767 
768    Collective on TS and Vec
769 
770    Input Parameters:
771 +  ts - the TS context
772 -  t - current time
773 
774    Output Parameter:
775 .  U - the function value
776 
777    Note:
778    Most users should not need to explicitly call this routine, as it
779    is used internally within the nonlinear solvers.
780 
781    Level: developer
782 
783 .keywords: TS, compute
784 
785 .seealso: TSSetSolutionFunction(), TSSetRHSFunction(), TSComputeIFunction()
786 @*/
787 PetscErrorCode TSComputeForcingFunction(TS ts,PetscReal t,Vec U)
788 {
789   PetscErrorCode     ierr, (*forcing)(TS,PetscReal,Vec,void*);
790   void               *ctx;
791   DM                 dm;
792 
793   PetscFunctionBegin;
794   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
795   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
796   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
797   ierr = DMTSGetForcingFunction(dm,&forcing,&ctx);CHKERRQ(ierr);
798 
799   if (forcing) {
800     PetscStackPush("TS user forcing function");
801     ierr = (*forcing)(ts,t,U,ctx);CHKERRQ(ierr);
802     PetscStackPop;
803   }
804   PetscFunctionReturn(0);
805 }
806 
807 static PetscErrorCode TSGetRHSVec_Private(TS ts,Vec *Frhs)
808 {
809   Vec            F;
810   PetscErrorCode ierr;
811 
812   PetscFunctionBegin;
813   *Frhs = NULL;
814   ierr  = TSGetIFunction(ts,&F,NULL,NULL);CHKERRQ(ierr);
815   if (!ts->Frhs) {
816     ierr = VecDuplicate(F,&ts->Frhs);CHKERRQ(ierr);
817   }
818   *Frhs = ts->Frhs;
819   PetscFunctionReturn(0);
820 }
821 
822 static PetscErrorCode TSGetRHSMats_Private(TS ts,Mat *Arhs,Mat *Brhs)
823 {
824   Mat            A,B;
825   PetscErrorCode ierr;
826   TSIJacobian    ijacobian;
827 
828   PetscFunctionBegin;
829   if (Arhs) *Arhs = NULL;
830   if (Brhs) *Brhs = NULL;
831   ierr = TSGetIJacobian(ts,&A,&B,&ijacobian,NULL);CHKERRQ(ierr);
832   if (Arhs) {
833     if (!ts->Arhs) {
834       if (ijacobian) {
835         ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&ts->Arhs);CHKERRQ(ierr);
836       } else {
837         ts->Arhs = A;
838         ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
839       }
840     } else {
841       PetscBool flg;
842       ierr = SNESGetUseMatrixFree(ts->snes,NULL,&flg);CHKERRQ(ierr);
843       /* Handle case where user provided only RHSJacobian and used -snes_mf_operator */
844       if (flg && !ijacobian && ts->Arhs == ts->Brhs){
845         ierr = PetscObjectDereference((PetscObject)ts->Arhs);CHKERRQ(ierr);
846         ts->Arhs = A;
847         ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
848       }
849     }
850     *Arhs = ts->Arhs;
851   }
852   if (Brhs) {
853     if (!ts->Brhs) {
854       if (A != B) {
855         if (ijacobian) {
856           ierr = MatDuplicate(B,MAT_DO_NOT_COPY_VALUES,&ts->Brhs);CHKERRQ(ierr);
857         } else {
858           ts->Brhs = B;
859           ierr = PetscObjectReference((PetscObject)B);CHKERRQ(ierr);
860         }
861       } else {
862         ierr = PetscObjectReference((PetscObject)ts->Arhs);CHKERRQ(ierr);
863         ts->Brhs = ts->Arhs;
864       }
865     }
866     *Brhs = ts->Brhs;
867   }
868   PetscFunctionReturn(0);
869 }
870 
871 /*@
872    TSComputeIFunction - Evaluates the DAE residual written in implicit form F(t,U,Udot)=0
873 
874    Collective on TS and Vec
875 
876    Input Parameters:
877 +  ts - the TS context
878 .  t - current time
879 .  U - state vector
880 .  Udot - time derivative of state vector
881 -  imex - flag indicates if the method is IMEX so that the RHSFunction should be kept separate
882 
883    Output Parameter:
884 .  Y - right hand side
885 
886    Note:
887    Most users should not need to explicitly call this routine, as it
888    is used internally within the nonlinear solvers.
889 
890    If the user did did not write their equations in implicit form, this
891    function recasts them in implicit form.
892 
893    Level: developer
894 
895 .keywords: TS, compute
896 
897 .seealso: TSSetIFunction(), TSComputeRHSFunction()
898 @*/
899 PetscErrorCode TSComputeIFunction(TS ts,PetscReal t,Vec U,Vec Udot,Vec Y,PetscBool imex)
900 {
901   PetscErrorCode ierr;
902   TSIFunction    ifunction;
903   TSRHSFunction  rhsfunction;
904   void           *ctx;
905   DM             dm;
906 
907   PetscFunctionBegin;
908   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
909   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
910   PetscValidHeaderSpecific(Udot,VEC_CLASSID,4);
911   PetscValidHeaderSpecific(Y,VEC_CLASSID,5);
912 
913   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
914   ierr = DMTSGetIFunction(dm,&ifunction,&ctx);CHKERRQ(ierr);
915   ierr = DMTSGetRHSFunction(dm,&rhsfunction,NULL);CHKERRQ(ierr);
916 
917   if (!rhsfunction && !ifunction) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"Must call TSSetRHSFunction() and / or TSSetIFunction()");
918 
919   ierr = PetscLogEventBegin(TS_FunctionEval,ts,U,Udot,Y);CHKERRQ(ierr);
920   if (ifunction) {
921     PetscStackPush("TS user implicit function");
922     ierr = (*ifunction)(ts,t,U,Udot,Y,ctx);CHKERRQ(ierr);
923     PetscStackPop;
924   }
925   if (imex) {
926     if (!ifunction) {
927       ierr = VecCopy(Udot,Y);CHKERRQ(ierr);
928     }
929   } else if (rhsfunction) {
930     if (ifunction) {
931       Vec Frhs;
932       ierr = TSGetRHSVec_Private(ts,&Frhs);CHKERRQ(ierr);
933       ierr = TSComputeRHSFunction(ts,t,U,Frhs);CHKERRQ(ierr);
934       ierr = VecAXPY(Y,-1,Frhs);CHKERRQ(ierr);
935     } else {
936       ierr = TSComputeRHSFunction(ts,t,U,Y);CHKERRQ(ierr);
937       ierr = VecAYPX(Y,-1,Udot);CHKERRQ(ierr);
938     }
939   }
940   ierr = PetscLogEventEnd(TS_FunctionEval,ts,U,Udot,Y);CHKERRQ(ierr);
941   PetscFunctionReturn(0);
942 }
943 
944 /*@
945    TSComputeIJacobian - Evaluates the Jacobian of the DAE
946 
947    Collective on TS and Vec
948 
949    Input
950       Input Parameters:
951 +  ts - the TS context
952 .  t - current timestep
953 .  U - state vector
954 .  Udot - time derivative of state vector
955 .  shift - shift to apply, see note below
956 -  imex - flag indicates if the method is IMEX so that the RHSJacobian should be kept separate
957 
958    Output Parameters:
959 +  A - Jacobian matrix
960 -  B - matrix from which the preconditioner is constructed; often the same as A
961 
962    Notes:
963    If F(t,U,Udot)=0 is the DAE, the required Jacobian is
964 
965    dF/dU + shift*dF/dUdot
966 
967    Most users should not need to explicitly call this routine, as it
968    is used internally within the nonlinear solvers.
969 
970    Level: developer
971 
972 .keywords: TS, compute, Jacobian, matrix
973 
974 .seealso:  TSSetIJacobian()
975 @*/
976 PetscErrorCode TSComputeIJacobian(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal shift,Mat A,Mat B,PetscBool imex)
977 {
978   PetscErrorCode ierr;
979   TSIJacobian    ijacobian;
980   TSRHSJacobian  rhsjacobian;
981   DM             dm;
982   void           *ctx;
983 
984   PetscFunctionBegin;
985   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
986   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
987   PetscValidHeaderSpecific(Udot,VEC_CLASSID,4);
988   PetscValidPointer(A,6);
989   PetscValidHeaderSpecific(A,MAT_CLASSID,6);
990   PetscValidPointer(B,7);
991   PetscValidHeaderSpecific(B,MAT_CLASSID,7);
992 
993   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
994   ierr = DMTSGetIJacobian(dm,&ijacobian,&ctx);CHKERRQ(ierr);
995   ierr = DMTSGetRHSJacobian(dm,&rhsjacobian,NULL);CHKERRQ(ierr);
996 
997   if (!rhsjacobian && !ijacobian) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"Must call TSSetRHSJacobian() and / or TSSetIJacobian()");
998 
999   ierr = PetscLogEventBegin(TS_JacobianEval,ts,U,A,B);CHKERRQ(ierr);
1000   if (ijacobian) {
1001     PetscBool missing;
1002     PetscStackPush("TS user implicit Jacobian");
1003     ierr = (*ijacobian)(ts,t,U,Udot,shift,A,B,ctx);CHKERRQ(ierr);
1004     PetscStackPop;
1005     ierr = MatMissingDiagonal(A,&missing,NULL);CHKERRQ(ierr);
1006     if (missing) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Amat passed to TSSetIJacobian() must have all diagonal entries set, if they are zero you must still set them with a zero value");
1007     if (B != A) {
1008       ierr = MatMissingDiagonal(B,&missing,NULL);CHKERRQ(ierr);
1009       if (missing) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Bmat passed to TSSetIJacobian() must have all diagonal entries set, if they are zero you must still set them with a zero value");
1010     }
1011   }
1012   if (imex) {
1013     if (!ijacobian) {  /* system was written as Udot = G(t,U) */
1014       PetscBool assembled;
1015       ierr = MatZeroEntries(A);CHKERRQ(ierr);
1016       ierr = MatAssembled(A,&assembled);CHKERRQ(ierr);
1017       if (!assembled) {
1018         ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1019         ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1020       }
1021       ierr = MatShift(A,shift);CHKERRQ(ierr);
1022       if (A != B) {
1023         ierr = MatZeroEntries(B);CHKERRQ(ierr);
1024         ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
1025         if (!assembled) {
1026           ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1027           ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1028         }
1029         ierr = MatShift(B,shift);CHKERRQ(ierr);
1030       }
1031     }
1032   } else {
1033     Mat Arhs = NULL,Brhs = NULL;
1034     if (rhsjacobian) {
1035       ierr = TSGetRHSMats_Private(ts,&Arhs,&Brhs);CHKERRQ(ierr);
1036       ierr = TSComputeRHSJacobian(ts,t,U,Arhs,Brhs);CHKERRQ(ierr);
1037     }
1038     if (Arhs == A) {           /* No IJacobian, so we only have the RHS matrix */
1039       PetscBool flg;
1040       ts->rhsjacobian.scale = -1;
1041       ts->rhsjacobian.shift = shift;
1042       ierr = SNESGetUseMatrixFree(ts->snes,NULL,&flg);CHKERRQ(ierr);
1043       /* since -snes_mf_operator uses the full SNES function it does not need to be shifted or scaled here */
1044       if (!flg) {
1045         ierr = MatScale(A,-1);CHKERRQ(ierr);
1046         ierr = MatShift(A,shift);CHKERRQ(ierr);
1047       }
1048       if (A != B) {
1049         ierr = MatScale(B,-1);CHKERRQ(ierr);
1050         ierr = MatShift(B,shift);CHKERRQ(ierr);
1051       }
1052     } else if (Arhs) {          /* Both IJacobian and RHSJacobian */
1053       MatStructure axpy = DIFFERENT_NONZERO_PATTERN;
1054       if (!ijacobian) {         /* No IJacobian provided, but we have a separate RHS matrix */
1055         ierr = MatZeroEntries(A);CHKERRQ(ierr);
1056         ierr = MatShift(A,shift);CHKERRQ(ierr);
1057         if (A != B) {
1058           ierr = MatZeroEntries(B);CHKERRQ(ierr);
1059           ierr = MatShift(B,shift);CHKERRQ(ierr);
1060         }
1061       }
1062       ierr = MatAXPY(A,-1,Arhs,axpy);CHKERRQ(ierr);
1063       if (A != B) {
1064         ierr = MatAXPY(B,-1,Brhs,axpy);CHKERRQ(ierr);
1065       }
1066     }
1067   }
1068   ierr = PetscLogEventEnd(TS_JacobianEval,ts,U,A,B);CHKERRQ(ierr);
1069   PetscFunctionReturn(0);
1070 }
1071 
1072 /*@C
1073     TSSetRHSFunction - Sets the routine for evaluating the function,
1074     where U_t = G(t,u).
1075 
1076     Logically Collective on TS
1077 
1078     Input Parameters:
1079 +   ts - the TS context obtained from TSCreate()
1080 .   r - vector to put the computed right hand side (or NULL to have it created)
1081 .   f - routine for evaluating the right-hand-side function
1082 -   ctx - [optional] user-defined context for private data for the
1083           function evaluation routine (may be NULL)
1084 
1085     Calling sequence of func:
1086 $     func (TS ts,PetscReal t,Vec u,Vec F,void *ctx);
1087 
1088 +   t - current timestep
1089 .   u - input vector
1090 .   F - function vector
1091 -   ctx - [optional] user-defined function context
1092 
1093     Level: beginner
1094 
1095     Notes: You must call this function or TSSetIFunction() to define your ODE. You cannot use this function when solving a DAE.
1096 
1097 .keywords: TS, timestep, set, right-hand-side, function
1098 
1099 .seealso: TSSetRHSJacobian(), TSSetIJacobian(), TSSetIFunction()
1100 @*/
1101 PetscErrorCode  TSSetRHSFunction(TS ts,Vec r,PetscErrorCode (*f)(TS,PetscReal,Vec,Vec,void*),void *ctx)
1102 {
1103   PetscErrorCode ierr;
1104   SNES           snes;
1105   Vec            ralloc = NULL;
1106   DM             dm;
1107 
1108   PetscFunctionBegin;
1109   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1110   if (r) PetscValidHeaderSpecific(r,VEC_CLASSID,2);
1111 
1112   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1113   ierr = DMTSSetRHSFunction(dm,f,ctx);CHKERRQ(ierr);
1114   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1115   if (!r && !ts->dm && ts->vec_sol) {
1116     ierr = VecDuplicate(ts->vec_sol,&ralloc);CHKERRQ(ierr);
1117     r = ralloc;
1118   }
1119   ierr = SNESSetFunction(snes,r,SNESTSFormFunction,ts);CHKERRQ(ierr);
1120   ierr = VecDestroy(&ralloc);CHKERRQ(ierr);
1121   PetscFunctionReturn(0);
1122 }
1123 
1124 /*@C
1125     TSSetSolutionFunction - Provide a function that computes the solution of the ODE or DAE
1126 
1127     Logically Collective on TS
1128 
1129     Input Parameters:
1130 +   ts - the TS context obtained from TSCreate()
1131 .   f - routine for evaluating the solution
1132 -   ctx - [optional] user-defined context for private data for the
1133           function evaluation routine (may be NULL)
1134 
1135     Calling sequence of func:
1136 $     func (TS ts,PetscReal t,Vec u,void *ctx);
1137 
1138 +   t - current timestep
1139 .   u - output vector
1140 -   ctx - [optional] user-defined function context
1141 
1142     Options Database:
1143 +  -ts_monitor_lg_error - create a graphical monitor of error history, requires user to have provided TSSetSolutionFunction()
1144 -  -ts_monitor_draw_error - Monitor error graphically, requires user to have provided TSSetSolutionFunction()
1145 
1146     Notes:
1147     This routine is used for testing accuracy of time integration schemes when you already know the solution.
1148     If analytic solutions are not known for your system, consider using the Method of Manufactured Solutions to
1149     create closed-form solutions with non-physical forcing terms.
1150 
1151     For low-dimensional problems solved in serial, such as small discrete systems, TSMonitorLGError() can be used to monitor the error history.
1152 
1153     Level: beginner
1154 
1155 .keywords: TS, timestep, set, right-hand-side, function
1156 
1157 .seealso: TSSetRHSJacobian(), TSSetIJacobian(), TSComputeSolutionFunction(), TSSetForcingFunction(), TSSetSolution(), TSGetSolution(), TSMonitorLGError(), TSMonitorDrawError()
1158 @*/
1159 PetscErrorCode  TSSetSolutionFunction(TS ts,PetscErrorCode (*f)(TS,PetscReal,Vec,void*),void *ctx)
1160 {
1161   PetscErrorCode ierr;
1162   DM             dm;
1163 
1164   PetscFunctionBegin;
1165   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1166   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1167   ierr = DMTSSetSolutionFunction(dm,f,ctx);CHKERRQ(ierr);
1168   PetscFunctionReturn(0);
1169 }
1170 
1171 /*@C
1172     TSSetForcingFunction - Provide a function that computes a forcing term for a ODE or PDE
1173 
1174     Logically Collective on TS
1175 
1176     Input Parameters:
1177 +   ts - the TS context obtained from TSCreate()
1178 .   func - routine for evaluating the forcing function
1179 -   ctx - [optional] user-defined context for private data for the
1180           function evaluation routine (may be NULL)
1181 
1182     Calling sequence of func:
1183 $     func (TS ts,PetscReal t,Vec f,void *ctx);
1184 
1185 +   t - current timestep
1186 .   f - output vector
1187 -   ctx - [optional] user-defined function context
1188 
1189     Notes:
1190     This routine is useful for testing accuracy of time integration schemes when using the Method of Manufactured Solutions to
1191     create closed-form solutions with a non-physical forcing term. It allows you to use the Method of Manufactored Solution without directly editing the
1192     definition of the problem you are solving and hence possibly introducing bugs.
1193 
1194     This replaces the ODE F(u,u_t,t) = 0 the TS is solving with F(u,u_t,t) - func(t) = 0
1195 
1196     This forcing function does not depend on the solution to the equations, it can only depend on spatial location, time, and possibly parameters, the
1197     parameters can be passed in the ctx variable.
1198 
1199     For low-dimensional problems solved in serial, such as small discrete systems, TSMonitorLGError() can be used to monitor the error history.
1200 
1201     Level: beginner
1202 
1203 .keywords: TS, timestep, set, right-hand-side, function
1204 
1205 .seealso: TSSetRHSJacobian(), TSSetIJacobian(), TSComputeSolutionFunction(), TSSetSolutionFunction()
1206 @*/
1207 PetscErrorCode  TSSetForcingFunction(TS ts,TSForcingFunction func,void *ctx)
1208 {
1209   PetscErrorCode ierr;
1210   DM             dm;
1211 
1212   PetscFunctionBegin;
1213   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1214   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1215   ierr = DMTSSetForcingFunction(dm,func,ctx);CHKERRQ(ierr);
1216   PetscFunctionReturn(0);
1217 }
1218 
1219 /*@C
1220    TSSetRHSJacobian - Sets the function to compute the Jacobian of G,
1221    where U_t = G(U,t), as well as the location to store the matrix.
1222 
1223    Logically Collective on TS
1224 
1225    Input Parameters:
1226 +  ts  - the TS context obtained from TSCreate()
1227 .  Amat - (approximate) Jacobian matrix
1228 .  Pmat - matrix from which preconditioner is to be constructed (usually the same as Amat)
1229 .  f   - the Jacobian evaluation routine
1230 -  ctx - [optional] user-defined context for private data for the
1231          Jacobian evaluation routine (may be NULL)
1232 
1233    Calling sequence of f:
1234 $     func (TS ts,PetscReal t,Vec u,Mat A,Mat B,void *ctx);
1235 
1236 +  t - current timestep
1237 .  u - input vector
1238 .  Amat - (approximate) Jacobian matrix
1239 .  Pmat - matrix from which preconditioner is to be constructed (usually the same as Amat)
1240 -  ctx - [optional] user-defined context for matrix evaluation routine
1241 
1242    Notes:
1243    You must set all the diagonal entries of the matrices, if they are zero you must still set them with a zero value
1244 
1245    The TS solver may modify the nonzero structure and the entries of the matrices Amat and Pmat between the calls to f()
1246    You should not assume the values are the same in the next call to f() as you set them in the previous call.
1247 
1248    Level: beginner
1249 
1250 .keywords: TS, timestep, set, right-hand-side, Jacobian
1251 
1252 .seealso: SNESComputeJacobianDefaultColor(), TSSetRHSFunction(), TSRHSJacobianSetReuse(), TSSetIJacobian()
1253 
1254 @*/
1255 PetscErrorCode  TSSetRHSJacobian(TS ts,Mat Amat,Mat Pmat,TSRHSJacobian f,void *ctx)
1256 {
1257   PetscErrorCode ierr;
1258   SNES           snes;
1259   DM             dm;
1260   TSIJacobian    ijacobian;
1261 
1262   PetscFunctionBegin;
1263   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1264   if (Amat) PetscValidHeaderSpecific(Amat,MAT_CLASSID,2);
1265   if (Pmat) PetscValidHeaderSpecific(Pmat,MAT_CLASSID,3);
1266   if (Amat) PetscCheckSameComm(ts,1,Amat,2);
1267   if (Pmat) PetscCheckSameComm(ts,1,Pmat,3);
1268 
1269   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1270   ierr = DMTSSetRHSJacobian(dm,f,ctx);CHKERRQ(ierr);
1271   if (f == TSComputeRHSJacobianConstant) {
1272     /* Handle this case automatically for the user; otherwise user should call themselves. */
1273     ierr = TSRHSJacobianSetReuse(ts,PETSC_TRUE);CHKERRQ(ierr);
1274   }
1275   ierr = DMTSGetIJacobian(dm,&ijacobian,NULL);CHKERRQ(ierr);
1276   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1277   if (!ijacobian) {
1278     ierr = SNESSetJacobian(snes,Amat,Pmat,SNESTSFormJacobian,ts);CHKERRQ(ierr);
1279   }
1280   if (Amat) {
1281     ierr = PetscObjectReference((PetscObject)Amat);CHKERRQ(ierr);
1282     ierr = MatDestroy(&ts->Arhs);CHKERRQ(ierr);
1283     ts->Arhs = Amat;
1284   }
1285   if (Pmat) {
1286     ierr = PetscObjectReference((PetscObject)Pmat);CHKERRQ(ierr);
1287     ierr = MatDestroy(&ts->Brhs);CHKERRQ(ierr);
1288     ts->Brhs = Pmat;
1289   }
1290   PetscFunctionReturn(0);
1291 }
1292 
1293 /*@C
1294    TSSetIFunction - Set the function to compute F(t,U,U_t) where F() = 0 is the DAE to be solved.
1295 
1296    Logically Collective on TS
1297 
1298    Input Parameters:
1299 +  ts  - the TS context obtained from TSCreate()
1300 .  r   - vector to hold the residual (or NULL to have it created internally)
1301 .  f   - the function evaluation routine
1302 -  ctx - user-defined context for private data for the function evaluation routine (may be NULL)
1303 
1304    Calling sequence of f:
1305 $  f(TS ts,PetscReal t,Vec u,Vec u_t,Vec F,ctx);
1306 
1307 +  t   - time at step/stage being solved
1308 .  u   - state vector
1309 .  u_t - time derivative of state vector
1310 .  F   - function vector
1311 -  ctx - [optional] user-defined context for matrix evaluation routine
1312 
1313    Important:
1314    The user MUST call either this routine or TSSetRHSFunction() to define the ODE.  When solving DAEs you must use this function.
1315 
1316    Level: beginner
1317 
1318 .keywords: TS, timestep, set, DAE, Jacobian
1319 
1320 .seealso: TSSetRHSJacobian(), TSSetRHSFunction(), TSSetIJacobian()
1321 @*/
1322 PetscErrorCode  TSSetIFunction(TS ts,Vec r,TSIFunction f,void *ctx)
1323 {
1324   PetscErrorCode ierr;
1325   SNES           snes;
1326   Vec            ralloc = NULL;
1327   DM             dm;
1328 
1329   PetscFunctionBegin;
1330   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1331   if (r) PetscValidHeaderSpecific(r,VEC_CLASSID,2);
1332 
1333   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1334   ierr = DMTSSetIFunction(dm,f,ctx);CHKERRQ(ierr);
1335 
1336   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1337   if (!r && !ts->dm && ts->vec_sol) {
1338     ierr = VecDuplicate(ts->vec_sol,&ralloc);CHKERRQ(ierr);
1339     r  = ralloc;
1340   }
1341   ierr = SNESSetFunction(snes,r,SNESTSFormFunction,ts);CHKERRQ(ierr);
1342   ierr = VecDestroy(&ralloc);CHKERRQ(ierr);
1343   PetscFunctionReturn(0);
1344 }
1345 
1346 /*@C
1347    TSGetIFunction - Returns the vector where the implicit residual is stored and the function/contex to compute it.
1348 
1349    Not Collective
1350 
1351    Input Parameter:
1352 .  ts - the TS context
1353 
1354    Output Parameter:
1355 +  r - vector to hold residual (or NULL)
1356 .  func - the function to compute residual (or NULL)
1357 -  ctx - the function context (or NULL)
1358 
1359    Level: advanced
1360 
1361 .keywords: TS, nonlinear, get, function
1362 
1363 .seealso: TSSetIFunction(), SNESGetFunction()
1364 @*/
1365 PetscErrorCode TSGetIFunction(TS ts,Vec *r,TSIFunction *func,void **ctx)
1366 {
1367   PetscErrorCode ierr;
1368   SNES           snes;
1369   DM             dm;
1370 
1371   PetscFunctionBegin;
1372   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1373   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1374   ierr = SNESGetFunction(snes,r,NULL,NULL);CHKERRQ(ierr);
1375   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1376   ierr = DMTSGetIFunction(dm,func,ctx);CHKERRQ(ierr);
1377   PetscFunctionReturn(0);
1378 }
1379 
1380 /*@C
1381    TSGetRHSFunction - Returns the vector where the right hand side is stored and the function/context to compute it.
1382 
1383    Not Collective
1384 
1385    Input Parameter:
1386 .  ts - the TS context
1387 
1388    Output Parameter:
1389 +  r - vector to hold computed right hand side (or NULL)
1390 .  func - the function to compute right hand side (or NULL)
1391 -  ctx - the function context (or NULL)
1392 
1393    Level: advanced
1394 
1395 .keywords: TS, nonlinear, get, function
1396 
1397 .seealso: TSSetRHSFunction(), SNESGetFunction()
1398 @*/
1399 PetscErrorCode TSGetRHSFunction(TS ts,Vec *r,TSRHSFunction *func,void **ctx)
1400 {
1401   PetscErrorCode ierr;
1402   SNES           snes;
1403   DM             dm;
1404 
1405   PetscFunctionBegin;
1406   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1407   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1408   ierr = SNESGetFunction(snes,r,NULL,NULL);CHKERRQ(ierr);
1409   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1410   ierr = DMTSGetRHSFunction(dm,func,ctx);CHKERRQ(ierr);
1411   PetscFunctionReturn(0);
1412 }
1413 
1414 /*@C
1415    TSSetIJacobian - Set the function to compute the matrix dF/dU + a*dF/dU_t where F(t,U,U_t) is the function
1416         provided with TSSetIFunction().
1417 
1418    Logically Collective on TS
1419 
1420    Input Parameters:
1421 +  ts  - the TS context obtained from TSCreate()
1422 .  Amat - (approximate) Jacobian matrix
1423 .  Pmat - matrix used to compute preconditioner (usually the same as Amat)
1424 .  f   - the Jacobian evaluation routine
1425 -  ctx - user-defined context for private data for the Jacobian evaluation routine (may be NULL)
1426 
1427    Calling sequence of f:
1428 $  f(TS ts,PetscReal t,Vec U,Vec U_t,PetscReal a,Mat Amat,Mat Pmat,void *ctx);
1429 
1430 +  t    - time at step/stage being solved
1431 .  U    - state vector
1432 .  U_t  - time derivative of state vector
1433 .  a    - shift
1434 .  Amat - (approximate) Jacobian of F(t,U,W+a*U), equivalent to dF/dU + a*dF/dU_t
1435 .  Pmat - matrix used for constructing preconditioner, usually the same as Amat
1436 -  ctx  - [optional] user-defined context for matrix evaluation routine
1437 
1438    Notes:
1439    The matrices Amat and Pmat are exactly the matrices that are used by SNES for the nonlinear solve.
1440 
1441    If you know the operator Amat has a null space you can use MatSetNullSpace() and MatSetTransposeNullSpace() to supply the null
1442    space to Amat and the KSP solvers will automatically use that null space as needed during the solution process.
1443 
1444    The matrix dF/dU + a*dF/dU_t you provide turns out to be
1445    the Jacobian of F(t,U,W+a*U) where F(t,U,U_t) = 0 is the DAE to be solved.
1446    The time integrator internally approximates U_t by W+a*U where the positive "shift"
1447    a and vector W depend on the integration method, step size, and past states. For example with
1448    the backward Euler method a = 1/dt and W = -a*U(previous timestep) so
1449    W + a*U = a*(U - U(previous timestep)) = (U - U(previous timestep))/dt
1450 
1451    You must set all the diagonal entries of the matrices, if they are zero you must still set them with a zero value
1452 
1453    The TS solver may modify the nonzero structure and the entries of the matrices Amat and Pmat between the calls to f()
1454    You should not assume the values are the same in the next call to f() as you set them in the previous call.
1455 
1456    Level: beginner
1457 
1458 .keywords: TS, timestep, DAE, Jacobian
1459 
1460 .seealso: TSSetIFunction(), TSSetRHSJacobian(), SNESComputeJacobianDefaultColor(), SNESComputeJacobianDefault(), TSSetRHSFunction()
1461 
1462 @*/
1463 PetscErrorCode  TSSetIJacobian(TS ts,Mat Amat,Mat Pmat,TSIJacobian f,void *ctx)
1464 {
1465   PetscErrorCode ierr;
1466   SNES           snes;
1467   DM             dm;
1468 
1469   PetscFunctionBegin;
1470   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1471   if (Amat) PetscValidHeaderSpecific(Amat,MAT_CLASSID,2);
1472   if (Pmat) PetscValidHeaderSpecific(Pmat,MAT_CLASSID,3);
1473   if (Amat) PetscCheckSameComm(ts,1,Amat,2);
1474   if (Pmat) PetscCheckSameComm(ts,1,Pmat,3);
1475 
1476   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1477   ierr = DMTSSetIJacobian(dm,f,ctx);CHKERRQ(ierr);
1478 
1479   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1480   ierr = SNESSetJacobian(snes,Amat,Pmat,SNESTSFormJacobian,ts);CHKERRQ(ierr);
1481   PetscFunctionReturn(0);
1482 }
1483 
1484 /*@
1485    TSRHSJacobianSetReuse - restore RHS Jacobian before re-evaluating.  Without this flag, TS will change the sign and
1486    shift the RHS Jacobian for a finite-time-step implicit solve, in which case the user function will need to recompute
1487    the entire Jacobian.  The reuse flag must be set if the evaluation function will assume that the matrix entries have
1488    not been changed by the TS.
1489 
1490    Logically Collective
1491 
1492    Input Arguments:
1493 +  ts - TS context obtained from TSCreate()
1494 -  reuse - PETSC_TRUE if the RHS Jacobian
1495 
1496    Level: intermediate
1497 
1498 .seealso: TSSetRHSJacobian(), TSComputeRHSJacobianConstant()
1499 @*/
1500 PetscErrorCode TSRHSJacobianSetReuse(TS ts,PetscBool reuse)
1501 {
1502   PetscFunctionBegin;
1503   ts->rhsjacobian.reuse = reuse;
1504   PetscFunctionReturn(0);
1505 }
1506 
1507 /*@C
1508    TSSetI2Function - Set the function to compute F(t,U,U_t,U_tt) where F = 0 is the DAE to be solved.
1509 
1510    Logically Collective on TS
1511 
1512    Input Parameters:
1513 +  ts  - the TS context obtained from TSCreate()
1514 .  F   - vector to hold the residual (or NULL to have it created internally)
1515 .  fun - the function evaluation routine
1516 -  ctx - user-defined context for private data for the function evaluation routine (may be NULL)
1517 
1518    Calling sequence of fun:
1519 $  fun(TS ts,PetscReal t,Vec U,Vec U_t,Vec U_tt,Vec F,ctx);
1520 
1521 +  t    - time at step/stage being solved
1522 .  U    - state vector
1523 .  U_t  - time derivative of state vector
1524 .  U_tt - second time derivative of state vector
1525 .  F    - function vector
1526 -  ctx  - [optional] user-defined context for matrix evaluation routine (may be NULL)
1527 
1528    Level: beginner
1529 
1530 .keywords: TS, timestep, set, ODE, DAE, Function
1531 
1532 .seealso: TSSetI2Jacobian()
1533 @*/
1534 PetscErrorCode TSSetI2Function(TS ts,Vec F,TSI2Function fun,void *ctx)
1535 {
1536   DM             dm;
1537   PetscErrorCode ierr;
1538 
1539   PetscFunctionBegin;
1540   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1541   if (F) PetscValidHeaderSpecific(F,VEC_CLASSID,2);
1542   ierr = TSSetIFunction(ts,F,NULL,NULL);CHKERRQ(ierr);
1543   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1544   ierr = DMTSSetI2Function(dm,fun,ctx);CHKERRQ(ierr);
1545   PetscFunctionReturn(0);
1546 }
1547 
1548 /*@C
1549   TSGetI2Function - Returns the vector where the implicit residual is stored and the function/contex to compute it.
1550 
1551   Not Collective
1552 
1553   Input Parameter:
1554 . ts - the TS context
1555 
1556   Output Parameter:
1557 + r - vector to hold residual (or NULL)
1558 . fun - the function to compute residual (or NULL)
1559 - ctx - the function context (or NULL)
1560 
1561   Level: advanced
1562 
1563 .keywords: TS, nonlinear, get, function
1564 
1565 .seealso: TSSetI2Function(), SNESGetFunction()
1566 @*/
1567 PetscErrorCode TSGetI2Function(TS ts,Vec *r,TSI2Function *fun,void **ctx)
1568 {
1569   PetscErrorCode ierr;
1570   SNES           snes;
1571   DM             dm;
1572 
1573   PetscFunctionBegin;
1574   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1575   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1576   ierr = SNESGetFunction(snes,r,NULL,NULL);CHKERRQ(ierr);
1577   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1578   ierr = DMTSGetI2Function(dm,fun,ctx);CHKERRQ(ierr);
1579   PetscFunctionReturn(0);
1580 }
1581 
1582 /*@C
1583    TSSetI2Jacobian - Set the function to compute the matrix dF/dU + v*dF/dU_t  + a*dF/dU_tt
1584         where F(t,U,U_t,U_tt) is the function you provided with TSSetI2Function().
1585 
1586    Logically Collective on TS
1587 
1588    Input Parameters:
1589 +  ts  - the TS context obtained from TSCreate()
1590 .  J   - Jacobian matrix
1591 .  P   - preconditioning matrix for J (may be same as J)
1592 .  jac - the Jacobian evaluation routine
1593 -  ctx - user-defined context for private data for the Jacobian evaluation routine (may be NULL)
1594 
1595    Calling sequence of jac:
1596 $  jac(TS ts,PetscReal t,Vec U,Vec U_t,Vec U_tt,PetscReal v,PetscReal a,Mat J,Mat P,void *ctx);
1597 
1598 +  t    - time at step/stage being solved
1599 .  U    - state vector
1600 .  U_t  - time derivative of state vector
1601 .  U_tt - second time derivative of state vector
1602 .  v    - shift for U_t
1603 .  a    - shift for U_tt
1604 .  J    - Jacobian of G(U) = F(t,U,W+v*U,W'+a*U), equivalent to dF/dU + v*dF/dU_t  + a*dF/dU_tt
1605 .  P    - preconditioning matrix for J, may be same as J
1606 -  ctx  - [optional] user-defined context for matrix evaluation routine
1607 
1608    Notes:
1609    The matrices J and P are exactly the matrices that are used by SNES for the nonlinear solve.
1610 
1611    The matrix dF/dU + v*dF/dU_t + a*dF/dU_tt you provide turns out to be
1612    the Jacobian of G(U) = F(t,U,W+v*U,W'+a*U) where F(t,U,U_t,U_tt) = 0 is the DAE to be solved.
1613    The time integrator internally approximates U_t by W+v*U and U_tt by W'+a*U  where the positive "shift"
1614    parameters 'v' and 'a' and vectors W, W' depend on the integration method, step size, and past states.
1615 
1616    Level: beginner
1617 
1618 .keywords: TS, timestep, set, ODE, DAE, Jacobian
1619 
1620 .seealso: TSSetI2Function()
1621 @*/
1622 PetscErrorCode TSSetI2Jacobian(TS ts,Mat J,Mat P,TSI2Jacobian jac,void *ctx)
1623 {
1624   DM             dm;
1625   PetscErrorCode ierr;
1626 
1627   PetscFunctionBegin;
1628   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1629   if (J) PetscValidHeaderSpecific(J,MAT_CLASSID,2);
1630   if (P) PetscValidHeaderSpecific(P,MAT_CLASSID,3);
1631   ierr = TSSetIJacobian(ts,J,P,NULL,NULL);CHKERRQ(ierr);
1632   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1633   ierr = DMTSSetI2Jacobian(dm,jac,ctx);CHKERRQ(ierr);
1634   PetscFunctionReturn(0);
1635 }
1636 
1637 /*@C
1638   TSGetI2Jacobian - Returns the implicit Jacobian at the present timestep.
1639 
1640   Not Collective, but parallel objects are returned if TS is parallel
1641 
1642   Input Parameter:
1643 . ts  - The TS context obtained from TSCreate()
1644 
1645   Output Parameters:
1646 + J  - The (approximate) Jacobian of F(t,U,U_t,U_tt)
1647 . P - The matrix from which the preconditioner is constructed, often the same as J
1648 . jac - The function to compute the Jacobian matrices
1649 - ctx - User-defined context for Jacobian evaluation routine
1650 
1651   Notes: You can pass in NULL for any return argument you do not need.
1652 
1653   Level: advanced
1654 
1655 .seealso: TSGetTimeStep(), TSGetMatrices(), TSGetTime(), TSGetStepNumber()
1656 
1657 .keywords: TS, timestep, get, matrix, Jacobian
1658 @*/
1659 PetscErrorCode  TSGetI2Jacobian(TS ts,Mat *J,Mat *P,TSI2Jacobian *jac,void **ctx)
1660 {
1661   PetscErrorCode ierr;
1662   SNES           snes;
1663   DM             dm;
1664 
1665   PetscFunctionBegin;
1666   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1667   ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
1668   ierr = SNESGetJacobian(snes,J,P,NULL,NULL);CHKERRQ(ierr);
1669   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1670   ierr = DMTSGetI2Jacobian(dm,jac,ctx);CHKERRQ(ierr);
1671   PetscFunctionReturn(0);
1672 }
1673 
1674 /*@
1675   TSComputeI2Function - Evaluates the DAE residual written in implicit form F(t,U,U_t,U_tt) = 0
1676 
1677   Collective on TS and Vec
1678 
1679   Input Parameters:
1680 + ts - the TS context
1681 . t - current time
1682 . U - state vector
1683 . V - time derivative of state vector (U_t)
1684 - A - second time derivative of state vector (U_tt)
1685 
1686   Output Parameter:
1687 . F - the residual vector
1688 
1689   Note:
1690   Most users should not need to explicitly call this routine, as it
1691   is used internally within the nonlinear solvers.
1692 
1693   Level: developer
1694 
1695 .keywords: TS, compute, function, vector
1696 
1697 .seealso: TSSetI2Function()
1698 @*/
1699 PetscErrorCode TSComputeI2Function(TS ts,PetscReal t,Vec U,Vec V,Vec A,Vec F)
1700 {
1701   DM             dm;
1702   TSI2Function   I2Function;
1703   void           *ctx;
1704   TSRHSFunction  rhsfunction;
1705   PetscErrorCode ierr;
1706 
1707   PetscFunctionBegin;
1708   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1709   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
1710   PetscValidHeaderSpecific(V,VEC_CLASSID,4);
1711   PetscValidHeaderSpecific(A,VEC_CLASSID,5);
1712   PetscValidHeaderSpecific(F,VEC_CLASSID,6);
1713 
1714   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1715   ierr = DMTSGetI2Function(dm,&I2Function,&ctx);CHKERRQ(ierr);
1716   ierr = DMTSGetRHSFunction(dm,&rhsfunction,NULL);CHKERRQ(ierr);
1717 
1718   if (!I2Function) {
1719     ierr = TSComputeIFunction(ts,t,U,A,F,PETSC_FALSE);CHKERRQ(ierr);
1720     PetscFunctionReturn(0);
1721   }
1722 
1723   ierr = PetscLogEventBegin(TS_FunctionEval,ts,U,V,F);CHKERRQ(ierr);
1724 
1725   PetscStackPush("TS user implicit function");
1726   ierr = I2Function(ts,t,U,V,A,F,ctx);CHKERRQ(ierr);
1727   PetscStackPop;
1728 
1729   if (rhsfunction) {
1730     Vec Frhs;
1731     ierr = TSGetRHSVec_Private(ts,&Frhs);CHKERRQ(ierr);
1732     ierr = TSComputeRHSFunction(ts,t,U,Frhs);CHKERRQ(ierr);
1733     ierr = VecAXPY(F,-1,Frhs);CHKERRQ(ierr);
1734   }
1735 
1736   ierr = PetscLogEventEnd(TS_FunctionEval,ts,U,V,F);CHKERRQ(ierr);
1737   PetscFunctionReturn(0);
1738 }
1739 
1740 /*@
1741   TSComputeI2Jacobian - Evaluates the Jacobian of the DAE
1742 
1743   Collective on TS and Vec
1744 
1745   Input Parameters:
1746 + ts - the TS context
1747 . t - current timestep
1748 . U - state vector
1749 . V - time derivative of state vector
1750 . A - second time derivative of state vector
1751 . shiftV - shift to apply, see note below
1752 - shiftA - shift to apply, see note below
1753 
1754   Output Parameters:
1755 + J - Jacobian matrix
1756 - P - optional preconditioning matrix
1757 
1758   Notes:
1759   If F(t,U,V,A)=0 is the DAE, the required Jacobian is
1760 
1761   dF/dU + shiftV*dF/dV + shiftA*dF/dA
1762 
1763   Most users should not need to explicitly call this routine, as it
1764   is used internally within the nonlinear solvers.
1765 
1766   Level: developer
1767 
1768 .keywords: TS, compute, Jacobian, matrix
1769 
1770 .seealso:  TSSetI2Jacobian()
1771 @*/
1772 PetscErrorCode TSComputeI2Jacobian(TS ts,PetscReal t,Vec U,Vec V,Vec A,PetscReal shiftV,PetscReal shiftA,Mat J,Mat P)
1773 {
1774   DM             dm;
1775   TSI2Jacobian   I2Jacobian;
1776   void           *ctx;
1777   TSRHSJacobian  rhsjacobian;
1778   PetscErrorCode ierr;
1779 
1780   PetscFunctionBegin;
1781   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1782   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
1783   PetscValidHeaderSpecific(V,VEC_CLASSID,4);
1784   PetscValidHeaderSpecific(A,VEC_CLASSID,5);
1785   PetscValidHeaderSpecific(J,MAT_CLASSID,8);
1786   PetscValidHeaderSpecific(P,MAT_CLASSID,9);
1787 
1788   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1789   ierr = DMTSGetI2Jacobian(dm,&I2Jacobian,&ctx);CHKERRQ(ierr);
1790   ierr = DMTSGetRHSJacobian(dm,&rhsjacobian,NULL);CHKERRQ(ierr);
1791 
1792   if (!I2Jacobian) {
1793     ierr = TSComputeIJacobian(ts,t,U,A,shiftA,J,P,PETSC_FALSE);CHKERRQ(ierr);
1794     PetscFunctionReturn(0);
1795   }
1796 
1797   ierr = PetscLogEventBegin(TS_JacobianEval,ts,U,J,P);CHKERRQ(ierr);
1798 
1799   PetscStackPush("TS user implicit Jacobian");
1800   ierr = I2Jacobian(ts,t,U,V,A,shiftV,shiftA,J,P,ctx);CHKERRQ(ierr);
1801   PetscStackPop;
1802 
1803   if (rhsjacobian) {
1804     Mat Jrhs,Prhs; MatStructure axpy = DIFFERENT_NONZERO_PATTERN;
1805     ierr = TSGetRHSMats_Private(ts,&Jrhs,&Prhs);CHKERRQ(ierr);
1806     ierr = TSComputeRHSJacobian(ts,t,U,Jrhs,Prhs);CHKERRQ(ierr);
1807     ierr = MatAXPY(J,-1,Jrhs,axpy);CHKERRQ(ierr);
1808     if (P != J) {ierr = MatAXPY(P,-1,Prhs,axpy);CHKERRQ(ierr);}
1809   }
1810 
1811   ierr = PetscLogEventEnd(TS_JacobianEval,ts,U,J,P);CHKERRQ(ierr);
1812   PetscFunctionReturn(0);
1813 }
1814 
1815 /*@
1816    TS2SetSolution - Sets the initial solution and time derivative vectors
1817    for use by the TS routines handling second order equations.
1818 
1819    Logically Collective on TS and Vec
1820 
1821    Input Parameters:
1822 +  ts - the TS context obtained from TSCreate()
1823 .  u - the solution vector
1824 -  v - the time derivative vector
1825 
1826    Level: beginner
1827 
1828 .keywords: TS, timestep, set, solution, initial conditions
1829 @*/
1830 PetscErrorCode  TS2SetSolution(TS ts,Vec u,Vec v)
1831 {
1832   PetscErrorCode ierr;
1833 
1834   PetscFunctionBegin;
1835   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1836   PetscValidHeaderSpecific(u,VEC_CLASSID,2);
1837   PetscValidHeaderSpecific(v,VEC_CLASSID,3);
1838   ierr = TSSetSolution(ts,u);CHKERRQ(ierr);
1839   ierr = PetscObjectReference((PetscObject)v);CHKERRQ(ierr);
1840   ierr = VecDestroy(&ts->vec_dot);CHKERRQ(ierr);
1841   ts->vec_dot = v;
1842   PetscFunctionReturn(0);
1843 }
1844 
1845 /*@
1846    TS2GetSolution - Returns the solution and time derivative at the present timestep
1847    for second order equations. It is valid to call this routine inside the function
1848    that you are evaluating in order to move to the new timestep. This vector not
1849    changed until the solution at the next timestep has been calculated.
1850 
1851    Not Collective, but Vec returned is parallel if TS is parallel
1852 
1853    Input Parameter:
1854 .  ts - the TS context obtained from TSCreate()
1855 
1856    Output Parameter:
1857 +  u - the vector containing the solution
1858 -  v - the vector containing the time derivative
1859 
1860    Level: intermediate
1861 
1862 .seealso: TS2SetSolution(), TSGetTimeStep(), TSGetTime()
1863 
1864 .keywords: TS, timestep, get, solution
1865 @*/
1866 PetscErrorCode  TS2GetSolution(TS ts,Vec *u,Vec *v)
1867 {
1868   PetscFunctionBegin;
1869   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1870   if (u) PetscValidPointer(u,2);
1871   if (v) PetscValidPointer(v,3);
1872   if (u) *u = ts->vec_sol;
1873   if (v) *v = ts->vec_dot;
1874   PetscFunctionReturn(0);
1875 }
1876 
1877 /*@C
1878   TSLoad - Loads a KSP that has been stored in binary  with KSPView().
1879 
1880   Collective on PetscViewer
1881 
1882   Input Parameters:
1883 + newdm - the newly loaded TS, this needs to have been created with TSCreate() or
1884            some related function before a call to TSLoad().
1885 - viewer - binary file viewer, obtained from PetscViewerBinaryOpen()
1886 
1887    Level: intermediate
1888 
1889   Notes:
1890    The type is determined by the data in the file, any type set into the TS before this call is ignored.
1891 
1892   Notes for advanced users:
1893   Most users should not need to know the details of the binary storage
1894   format, since TSLoad() and TSView() completely hide these details.
1895   But for anyone who's interested, the standard binary matrix storage
1896   format is
1897 .vb
1898      has not yet been determined
1899 .ve
1900 
1901 .seealso: PetscViewerBinaryOpen(), TSView(), MatLoad(), VecLoad()
1902 @*/
1903 PetscErrorCode  TSLoad(TS ts, PetscViewer viewer)
1904 {
1905   PetscErrorCode ierr;
1906   PetscBool      isbinary;
1907   PetscInt       classid;
1908   char           type[256];
1909   DMTS           sdm;
1910   DM             dm;
1911 
1912   PetscFunctionBegin;
1913   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1914   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
1915   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1916   if (!isbinary) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid viewer; open viewer with PetscViewerBinaryOpen()");
1917 
1918   ierr = PetscViewerBinaryRead(viewer,&classid,1,NULL,PETSC_INT);CHKERRQ(ierr);
1919   if (classid != TS_FILE_CLASSID) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONG,"Not TS next in file");
1920   ierr = PetscViewerBinaryRead(viewer,type,256,NULL,PETSC_CHAR);CHKERRQ(ierr);
1921   ierr = TSSetType(ts, type);CHKERRQ(ierr);
1922   if (ts->ops->load) {
1923     ierr = (*ts->ops->load)(ts,viewer);CHKERRQ(ierr);
1924   }
1925   ierr = DMCreate(PetscObjectComm((PetscObject)ts),&dm);CHKERRQ(ierr);
1926   ierr = DMLoad(dm,viewer);CHKERRQ(ierr);
1927   ierr = TSSetDM(ts,dm);CHKERRQ(ierr);
1928   ierr = DMCreateGlobalVector(ts->dm,&ts->vec_sol);CHKERRQ(ierr);
1929   ierr = VecLoad(ts->vec_sol,viewer);CHKERRQ(ierr);
1930   ierr = DMGetDMTS(ts->dm,&sdm);CHKERRQ(ierr);
1931   ierr = DMTSLoad(sdm,viewer);CHKERRQ(ierr);
1932   PetscFunctionReturn(0);
1933 }
1934 
1935 #include <petscdraw.h>
1936 #if defined(PETSC_HAVE_SAWS)
1937 #include <petscviewersaws.h>
1938 #endif
1939 /*@C
1940     TSView - Prints the TS data structure.
1941 
1942     Collective on TS
1943 
1944     Input Parameters:
1945 +   ts - the TS context obtained from TSCreate()
1946 -   viewer - visualization context
1947 
1948     Options Database Key:
1949 .   -ts_view - calls TSView() at end of TSStep()
1950 
1951     Notes:
1952     The available visualization contexts include
1953 +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
1954 -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
1955          output where only the first processor opens
1956          the file.  All other processors send their
1957          data to the first processor to print.
1958 
1959     The user can open an alternative visualization context with
1960     PetscViewerASCIIOpen() - output to a specified file.
1961 
1962     Level: beginner
1963 
1964 .keywords: TS, timestep, view
1965 
1966 .seealso: PetscViewerASCIIOpen()
1967 @*/
1968 PetscErrorCode  TSView(TS ts,PetscViewer viewer)
1969 {
1970   PetscErrorCode ierr;
1971   TSType         type;
1972   PetscBool      iascii,isstring,isundials,isbinary,isdraw;
1973   DMTS           sdm;
1974 #if defined(PETSC_HAVE_SAWS)
1975   PetscBool      issaws;
1976 #endif
1977 
1978   PetscFunctionBegin;
1979   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1980   if (!viewer) {
1981     ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)ts),&viewer);CHKERRQ(ierr);
1982   }
1983   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
1984   PetscCheckSameComm(ts,1,viewer,2);
1985 
1986   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1987   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERSTRING,&isstring);CHKERRQ(ierr);
1988   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
1989   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
1990 #if defined(PETSC_HAVE_SAWS)
1991   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERSAWS,&issaws);CHKERRQ(ierr);
1992 #endif
1993   if (iascii) {
1994     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)ts,viewer);CHKERRQ(ierr);
1995     if (ts->ops->view) {
1996       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
1997       ierr = (*ts->ops->view)(ts,viewer);CHKERRQ(ierr);
1998       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
1999     }
2000     if (ts->max_steps < PETSC_MAX_INT) {
2001       ierr = PetscViewerASCIIPrintf(viewer,"  maximum steps=%D\n",ts->max_steps);CHKERRQ(ierr);
2002     }
2003     if (ts->max_time < PETSC_MAX_REAL) {
2004       ierr = PetscViewerASCIIPrintf(viewer,"  maximum time=%g\n",(double)ts->max_time);CHKERRQ(ierr);
2005     }
2006     if (ts->usessnes) {
2007       PetscBool lin;
2008       if (ts->problem_type == TS_NONLINEAR) {
2009         ierr = PetscViewerASCIIPrintf(viewer,"  total number of nonlinear solver iterations=%D\n",ts->snes_its);CHKERRQ(ierr);
2010       }
2011       ierr = PetscViewerASCIIPrintf(viewer,"  total number of linear solver iterations=%D\n",ts->ksp_its);CHKERRQ(ierr);
2012       ierr = PetscObjectTypeCompare((PetscObject)ts->snes,SNESKSPONLY,&lin);CHKERRQ(ierr);
2013       ierr = PetscViewerASCIIPrintf(viewer,"  total number of %slinear solve failures=%D\n",lin ? "" : "non",ts->num_snes_failures);CHKERRQ(ierr);
2014     }
2015     ierr = PetscViewerASCIIPrintf(viewer,"  total number of rejected steps=%D\n",ts->reject);CHKERRQ(ierr);
2016     if (ts->vrtol) {
2017       ierr = PetscViewerASCIIPrintf(viewer,"  using vector of relative error tolerances, ");CHKERRQ(ierr);
2018     } else {
2019       ierr = PetscViewerASCIIPrintf(viewer,"  using relative error tolerance of %g, ",(double)ts->rtol);CHKERRQ(ierr);
2020     }
2021     if (ts->vatol) {
2022       ierr = PetscViewerASCIIPrintf(viewer,"  using vector of absolute error tolerances\n");CHKERRQ(ierr);
2023     } else {
2024       ierr = PetscViewerASCIIPrintf(viewer,"  using absolute error tolerance of %g\n",(double)ts->atol);CHKERRQ(ierr);
2025     }
2026     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
2027     ierr = TSAdaptView(ts->adapt,viewer);CHKERRQ(ierr);
2028     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
2029     if (ts->snes && ts->usessnes)  {
2030       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
2031       ierr = SNESView(ts->snes,viewer);CHKERRQ(ierr);
2032       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
2033     }
2034     ierr = DMGetDMTS(ts->dm,&sdm);CHKERRQ(ierr);
2035     ierr = DMTSView(sdm,viewer);CHKERRQ(ierr);
2036   } else if (isstring) {
2037     ierr = TSGetType(ts,&type);CHKERRQ(ierr);
2038     ierr = PetscViewerStringSPrintf(viewer," %-7.7s",type);CHKERRQ(ierr);
2039   } else if (isbinary) {
2040     PetscInt    classid = TS_FILE_CLASSID;
2041     MPI_Comm    comm;
2042     PetscMPIInt rank;
2043     char        type[256];
2044 
2045     ierr = PetscObjectGetComm((PetscObject)ts,&comm);CHKERRQ(ierr);
2046     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
2047     if (!rank) {
2048       ierr = PetscViewerBinaryWrite(viewer,&classid,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
2049       ierr = PetscStrncpy(type,((PetscObject)ts)->type_name,256);CHKERRQ(ierr);
2050       ierr = PetscViewerBinaryWrite(viewer,type,256,PETSC_CHAR,PETSC_FALSE);CHKERRQ(ierr);
2051     }
2052     if (ts->ops->view) {
2053       ierr = (*ts->ops->view)(ts,viewer);CHKERRQ(ierr);
2054     }
2055     if (ts->adapt) {ierr = TSAdaptView(ts->adapt,viewer);CHKERRQ(ierr);}
2056     ierr = DMView(ts->dm,viewer);CHKERRQ(ierr);
2057     ierr = VecView(ts->vec_sol,viewer);CHKERRQ(ierr);
2058     ierr = DMGetDMTS(ts->dm,&sdm);CHKERRQ(ierr);
2059     ierr = DMTSView(sdm,viewer);CHKERRQ(ierr);
2060   } else if (isdraw) {
2061     PetscDraw draw;
2062     char      str[36];
2063     PetscReal x,y,bottom,h;
2064 
2065     ierr   = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
2066     ierr   = PetscDrawGetCurrentPoint(draw,&x,&y);CHKERRQ(ierr);
2067     ierr   = PetscStrcpy(str,"TS: ");CHKERRQ(ierr);
2068     ierr   = PetscStrcat(str,((PetscObject)ts)->type_name);CHKERRQ(ierr);
2069     ierr   = PetscDrawStringBoxed(draw,x,y,PETSC_DRAW_BLACK,PETSC_DRAW_BLACK,str,NULL,&h);CHKERRQ(ierr);
2070     bottom = y - h;
2071     ierr   = PetscDrawPushCurrentPoint(draw,x,bottom);CHKERRQ(ierr);
2072     if (ts->ops->view) {
2073       ierr = (*ts->ops->view)(ts,viewer);CHKERRQ(ierr);
2074     }
2075     if (ts->adapt) {ierr = TSAdaptView(ts->adapt,viewer);CHKERRQ(ierr);}
2076     if (ts->snes)  {ierr = SNESView(ts->snes,viewer);CHKERRQ(ierr);}
2077     ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
2078 #if defined(PETSC_HAVE_SAWS)
2079   } else if (issaws) {
2080     PetscMPIInt rank;
2081     const char  *name;
2082 
2083     ierr = PetscObjectGetName((PetscObject)ts,&name);CHKERRQ(ierr);
2084     ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
2085     if (!((PetscObject)ts)->amsmem && !rank) {
2086       char       dir[1024];
2087 
2088       ierr = PetscObjectViewSAWs((PetscObject)ts,viewer);CHKERRQ(ierr);
2089       ierr = PetscSNPrintf(dir,1024,"/PETSc/Objects/%s/time_step",name);CHKERRQ(ierr);
2090       PetscStackCallSAWs(SAWs_Register,(dir,&ts->steps,1,SAWs_READ,SAWs_INT));
2091       ierr = PetscSNPrintf(dir,1024,"/PETSc/Objects/%s/time",name);CHKERRQ(ierr);
2092       PetscStackCallSAWs(SAWs_Register,(dir,&ts->ptime,1,SAWs_READ,SAWs_DOUBLE));
2093     }
2094     if (ts->ops->view) {
2095       ierr = (*ts->ops->view)(ts,viewer);CHKERRQ(ierr);
2096     }
2097 #endif
2098   }
2099 
2100   ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
2101   ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&isundials);CHKERRQ(ierr);
2102   ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
2103   PetscFunctionReturn(0);
2104 }
2105 
2106 /*@
2107    TSSetApplicationContext - Sets an optional user-defined context for
2108    the timesteppers.
2109 
2110    Logically Collective on TS
2111 
2112    Input Parameters:
2113 +  ts - the TS context obtained from TSCreate()
2114 -  usrP - optional user context
2115 
2116    Fortran Notes: To use this from Fortran you must write a Fortran interface definition for this
2117     function that tells Fortran the Fortran derived data type that you are passing in as the ctx argument.
2118 
2119    Level: intermediate
2120 
2121 .keywords: TS, timestep, set, application, context
2122 
2123 .seealso: TSGetApplicationContext()
2124 @*/
2125 PetscErrorCode  TSSetApplicationContext(TS ts,void *usrP)
2126 {
2127   PetscFunctionBegin;
2128   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2129   ts->user = usrP;
2130   PetscFunctionReturn(0);
2131 }
2132 
2133 /*@
2134     TSGetApplicationContext - Gets the user-defined context for the
2135     timestepper.
2136 
2137     Not Collective
2138 
2139     Input Parameter:
2140 .   ts - the TS context obtained from TSCreate()
2141 
2142     Output Parameter:
2143 .   usrP - user context
2144 
2145    Fortran Notes: To use this from Fortran you must write a Fortran interface definition for this
2146     function that tells Fortran the Fortran derived data type that you are passing in as the ctx argument.
2147 
2148     Level: intermediate
2149 
2150 .keywords: TS, timestep, get, application, context
2151 
2152 .seealso: TSSetApplicationContext()
2153 @*/
2154 PetscErrorCode  TSGetApplicationContext(TS ts,void *usrP)
2155 {
2156   PetscFunctionBegin;
2157   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2158   *(void**)usrP = ts->user;
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 /*@
2163    TSGetStepNumber - Gets the number of steps completed.
2164 
2165    Not Collective
2166 
2167    Input Parameter:
2168 .  ts - the TS context obtained from TSCreate()
2169 
2170    Output Parameter:
2171 .  steps - number of steps completed so far
2172 
2173    Level: intermediate
2174 
2175 .keywords: TS, timestep, get, iteration, number
2176 .seealso: TSGetTime(), TSGetTimeStep(), TSSetPreStep(), TSSetPreStage(), TSSetPostStage(), TSSetPostStep()
2177 @*/
2178 PetscErrorCode TSGetStepNumber(TS ts,PetscInt *steps)
2179 {
2180   PetscFunctionBegin;
2181   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2182   PetscValidIntPointer(steps,2);
2183   *steps = ts->steps;
2184   PetscFunctionReturn(0);
2185 }
2186 
2187 /*@
2188    TSSetStepNumber - Sets the number of steps completed.
2189 
2190    Logically Collective on TS
2191 
2192    Input Parameters:
2193 +  ts - the TS context
2194 -  steps - number of steps completed so far
2195 
2196    Notes:
2197    For most uses of the TS solvers the user need not explicitly call
2198    TSSetStepNumber(), as the step counter is appropriately updated in
2199    TSSolve()/TSStep()/TSRollBack(). Power users may call this routine to
2200    reinitialize timestepping by setting the step counter to zero (and time
2201    to the initial time) to solve a similar problem with different initial
2202    conditions or parameters. Other possible use case is to continue
2203    timestepping from a previously interrupted run in such a way that TS
2204    monitors will be called with a initial nonzero step counter.
2205 
2206    Level: advanced
2207 
2208 .keywords: TS, timestep, set, iteration, number
2209 .seealso: TSGetStepNumber(), TSSetTime(), TSSetTimeStep(), TSSetSolution()
2210 @*/
2211 PetscErrorCode TSSetStepNumber(TS ts,PetscInt steps)
2212 {
2213   PetscFunctionBegin;
2214   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2215   PetscValidLogicalCollectiveInt(ts,steps,2);
2216   if (steps < 0) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_OUTOFRANGE,"Step number must be non-negative");
2217   ts->steps = steps;
2218   PetscFunctionReturn(0);
2219 }
2220 
2221 /*@
2222    TSSetTimeStep - Allows one to reset the timestep at any time,
2223    useful for simple pseudo-timestepping codes.
2224 
2225    Logically Collective on TS
2226 
2227    Input Parameters:
2228 +  ts - the TS context obtained from TSCreate()
2229 -  time_step - the size of the timestep
2230 
2231    Level: intermediate
2232 
2233 .seealso: TSGetTimeStep(), TSSetTime()
2234 
2235 .keywords: TS, set, timestep
2236 @*/
2237 PetscErrorCode  TSSetTimeStep(TS ts,PetscReal time_step)
2238 {
2239   PetscFunctionBegin;
2240   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2241   PetscValidLogicalCollectiveReal(ts,time_step,2);
2242   ts->time_step = time_step;
2243   PetscFunctionReturn(0);
2244 }
2245 
2246 /*@
2247    TSSetExactFinalTime - Determines whether to adapt the final time step to
2248      match the exact final time, interpolate solution to the exact final time,
2249      or just return at the final time TS computed.
2250 
2251   Logically Collective on TS
2252 
2253    Input Parameter:
2254 +   ts - the time-step context
2255 -   eftopt - exact final time option
2256 
2257 $  TS_EXACTFINALTIME_STEPOVER    - Don't do anything if final time is exceeded
2258 $  TS_EXACTFINALTIME_INTERPOLATE - Interpolate back to final time
2259 $  TS_EXACTFINALTIME_MATCHSTEP - Adapt final time step to match the final time
2260 
2261    Options Database:
2262 .   -ts_exact_final_time <stepover,interpolate,matchstep> - select the final step at runtime
2263 
2264    Warning: If you use the option TS_EXACTFINALTIME_STEPOVER the solution may be at a very different time
2265     then the final time you selected.
2266 
2267    Level: beginner
2268 
2269 .seealso: TSExactFinalTimeOption, TSGetExactFinalTime()
2270 @*/
2271 PetscErrorCode TSSetExactFinalTime(TS ts,TSExactFinalTimeOption eftopt)
2272 {
2273   PetscFunctionBegin;
2274   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2275   PetscValidLogicalCollectiveEnum(ts,eftopt,2);
2276   ts->exact_final_time = eftopt;
2277   PetscFunctionReturn(0);
2278 }
2279 
2280 /*@
2281    TSGetExactFinalTime - Gets the exact final time option.
2282 
2283    Not Collective
2284 
2285    Input Parameter:
2286 .  ts - the TS context
2287 
2288    Output Parameter:
2289 .  eftopt - exact final time option
2290 
2291    Level: beginner
2292 
2293 .seealso: TSExactFinalTimeOption, TSSetExactFinalTime()
2294 @*/
2295 PetscErrorCode TSGetExactFinalTime(TS ts,TSExactFinalTimeOption *eftopt)
2296 {
2297   PetscFunctionBegin;
2298   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2299   PetscValidPointer(eftopt,2);
2300   *eftopt = ts->exact_final_time;
2301   PetscFunctionReturn(0);
2302 }
2303 
2304 /*@
2305    TSGetTimeStep - Gets the current timestep size.
2306 
2307    Not Collective
2308 
2309    Input Parameter:
2310 .  ts - the TS context obtained from TSCreate()
2311 
2312    Output Parameter:
2313 .  dt - the current timestep size
2314 
2315    Level: intermediate
2316 
2317 .seealso: TSSetTimeStep(), TSGetTime()
2318 
2319 .keywords: TS, get, timestep
2320 @*/
2321 PetscErrorCode  TSGetTimeStep(TS ts,PetscReal *dt)
2322 {
2323   PetscFunctionBegin;
2324   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2325   PetscValidRealPointer(dt,2);
2326   *dt = ts->time_step;
2327   PetscFunctionReturn(0);
2328 }
2329 
2330 /*@
2331    TSGetSolution - Returns the solution at the present timestep. It
2332    is valid to call this routine inside the function that you are evaluating
2333    in order to move to the new timestep. This vector not changed until
2334    the solution at the next timestep has been calculated.
2335 
2336    Not Collective, but Vec returned is parallel if TS is parallel
2337 
2338    Input Parameter:
2339 .  ts - the TS context obtained from TSCreate()
2340 
2341    Output Parameter:
2342 .  v - the vector containing the solution
2343 
2344    Note: If you used TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP); this does not return the solution at the requested
2345    final time. It returns the solution at the next timestep.
2346 
2347    Level: intermediate
2348 
2349 .seealso: TSGetTimeStep(), TSGetTime(), TSGetSolveTime(), TSGetSolutionComponents(), TSSetSolutionFunction()
2350 
2351 .keywords: TS, timestep, get, solution
2352 @*/
2353 PetscErrorCode  TSGetSolution(TS ts,Vec *v)
2354 {
2355   PetscFunctionBegin;
2356   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2357   PetscValidPointer(v,2);
2358   *v = ts->vec_sol;
2359   PetscFunctionReturn(0);
2360 }
2361 
2362 /*@
2363    TSGetSolutionComponents - Returns any solution components at the present
2364    timestep, if available for the time integration method being used.
2365    Solution components are quantities that share the same size and
2366    structure as the solution vector.
2367 
2368    Not Collective, but Vec returned is parallel if TS is parallel
2369 
2370    Parameters :
2371 .  ts - the TS context obtained from TSCreate() (input parameter).
2372 .  n - If v is PETSC_NULL, then the number of solution components is
2373        returned through n, else the n-th solution component is
2374        returned in v.
2375 .  v - the vector containing the n-th solution component
2376        (may be PETSC_NULL to use this function to find out
2377         the number of solutions components).
2378 
2379    Level: advanced
2380 
2381 .seealso: TSGetSolution()
2382 
2383 .keywords: TS, timestep, get, solution
2384 @*/
2385 PetscErrorCode  TSGetSolutionComponents(TS ts,PetscInt *n,Vec *v)
2386 {
2387   PetscErrorCode ierr;
2388 
2389   PetscFunctionBegin;
2390   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2391   if (!ts->ops->getsolutioncomponents) *n = 0;
2392   else {
2393     ierr = (*ts->ops->getsolutioncomponents)(ts,n,v);CHKERRQ(ierr);
2394   }
2395   PetscFunctionReturn(0);
2396 }
2397 
2398 /*@
2399    TSGetAuxSolution - Returns an auxiliary solution at the present
2400    timestep, if available for the time integration method being used.
2401 
2402    Not Collective, but Vec returned is parallel if TS is parallel
2403 
2404    Parameters :
2405 .  ts - the TS context obtained from TSCreate() (input parameter).
2406 .  v - the vector containing the auxiliary solution
2407 
2408    Level: intermediate
2409 
2410 .seealso: TSGetSolution()
2411 
2412 .keywords: TS, timestep, get, solution
2413 @*/
2414 PetscErrorCode  TSGetAuxSolution(TS ts,Vec *v)
2415 {
2416   PetscErrorCode ierr;
2417 
2418   PetscFunctionBegin;
2419   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2420   if (ts->ops->getauxsolution) {
2421     ierr = (*ts->ops->getauxsolution)(ts,v);CHKERRQ(ierr);
2422   } else {
2423     ierr = VecZeroEntries(*v); CHKERRQ(ierr);
2424   }
2425   PetscFunctionReturn(0);
2426 }
2427 
2428 /*@
2429    TSGetTimeError - Returns the estimated error vector, if the chosen
2430    TSType has an error estimation functionality.
2431 
2432    Not Collective, but Vec returned is parallel if TS is parallel
2433 
2434    Note: MUST call after TSSetUp()
2435 
2436    Parameters :
2437 .  ts - the TS context obtained from TSCreate() (input parameter).
2438 .  n - current estimate (n=0) or previous one (n=-1)
2439 .  v - the vector containing the error (same size as the solution).
2440 
2441    Level: intermediate
2442 
2443 .seealso: TSGetSolution(), TSSetTimeError()
2444 
2445 .keywords: TS, timestep, get, error
2446 @*/
2447 PetscErrorCode  TSGetTimeError(TS ts,PetscInt n,Vec *v)
2448 {
2449   PetscErrorCode ierr;
2450 
2451   PetscFunctionBegin;
2452   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2453   if (ts->ops->gettimeerror) {
2454     ierr = (*ts->ops->gettimeerror)(ts,n,v);CHKERRQ(ierr);
2455   } else {
2456     ierr = VecZeroEntries(*v);CHKERRQ(ierr);
2457   }
2458   PetscFunctionReturn(0);
2459 }
2460 
2461 /*@
2462    TSSetTimeError - Sets the estimated error vector, if the chosen
2463    TSType has an error estimation functionality. This can be used
2464    to restart such a time integrator with a given error vector.
2465 
2466    Not Collective, but Vec returned is parallel if TS is parallel
2467 
2468    Parameters :
2469 .  ts - the TS context obtained from TSCreate() (input parameter).
2470 .  v - the vector containing the error (same size as the solution).
2471 
2472    Level: intermediate
2473 
2474 .seealso: TSSetSolution(), TSGetTimeError)
2475 
2476 .keywords: TS, timestep, get, error
2477 @*/
2478 PetscErrorCode  TSSetTimeError(TS ts,Vec v)
2479 {
2480   PetscErrorCode ierr;
2481 
2482   PetscFunctionBegin;
2483   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2484   if (!ts->setupcalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call TSSetUp() first");
2485   if (ts->ops->settimeerror) {
2486     ierr = (*ts->ops->settimeerror)(ts,v);CHKERRQ(ierr);
2487   }
2488   PetscFunctionReturn(0);
2489 }
2490 
2491 /*@
2492    TSGetCostGradients - Returns the gradients from the TSAdjointSolve()
2493 
2494    Not Collective, but Vec returned is parallel if TS is parallel
2495 
2496    Input Parameter:
2497 .  ts - the TS context obtained from TSCreate()
2498 
2499    Output Parameter:
2500 +  lambda - vectors containing the gradients of the cost functions with respect to the ODE/DAE solution variables
2501 -  mu - vectors containing the gradients of the cost functions with respect to the problem parameters
2502 
2503    Level: intermediate
2504 
2505 .seealso: TSGetTimeStep()
2506 
2507 .keywords: TS, timestep, get, sensitivity
2508 @*/
2509 PetscErrorCode  TSGetCostGradients(TS ts,PetscInt *numcost,Vec **lambda,Vec **mu)
2510 {
2511   PetscFunctionBegin;
2512   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2513   if (numcost) *numcost = ts->numcost;
2514   if (lambda)  *lambda  = ts->vecs_sensi;
2515   if (mu)      *mu      = ts->vecs_sensip;
2516   PetscFunctionReturn(0);
2517 }
2518 
2519 /* ----- Routines to initialize and destroy a timestepper ---- */
2520 /*@
2521   TSSetProblemType - Sets the type of problem to be solved.
2522 
2523   Not collective
2524 
2525   Input Parameters:
2526 + ts   - The TS
2527 - type - One of TS_LINEAR, TS_NONLINEAR where these types refer to problems of the forms
2528 .vb
2529          U_t - A U = 0      (linear)
2530          U_t - A(t) U = 0   (linear)
2531          F(t,U,U_t) = 0     (nonlinear)
2532 .ve
2533 
2534    Level: beginner
2535 
2536 .keywords: TS, problem type
2537 .seealso: TSSetUp(), TSProblemType, TS
2538 @*/
2539 PetscErrorCode  TSSetProblemType(TS ts, TSProblemType type)
2540 {
2541   PetscErrorCode ierr;
2542 
2543   PetscFunctionBegin;
2544   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
2545   ts->problem_type = type;
2546   if (type == TS_LINEAR) {
2547     SNES snes;
2548     ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
2549     ierr = SNESSetType(snes,SNESKSPONLY);CHKERRQ(ierr);
2550   }
2551   PetscFunctionReturn(0);
2552 }
2553 
2554 /*@C
2555   TSGetProblemType - Gets the type of problem to be solved.
2556 
2557   Not collective
2558 
2559   Input Parameter:
2560 . ts   - The TS
2561 
2562   Output Parameter:
2563 . type - One of TS_LINEAR, TS_NONLINEAR where these types refer to problems of the forms
2564 .vb
2565          M U_t = A U
2566          M(t) U_t = A(t) U
2567          F(t,U,U_t)
2568 .ve
2569 
2570    Level: beginner
2571 
2572 .keywords: TS, problem type
2573 .seealso: TSSetUp(), TSProblemType, TS
2574 @*/
2575 PetscErrorCode  TSGetProblemType(TS ts, TSProblemType *type)
2576 {
2577   PetscFunctionBegin;
2578   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
2579   PetscValidIntPointer(type,2);
2580   *type = ts->problem_type;
2581   PetscFunctionReturn(0);
2582 }
2583 
2584 /*@
2585    TSSetUp - Sets up the internal data structures for the later use
2586    of a timestepper.
2587 
2588    Collective on TS
2589 
2590    Input Parameter:
2591 .  ts - the TS context obtained from TSCreate()
2592 
2593    Notes:
2594    For basic use of the TS solvers the user need not explicitly call
2595    TSSetUp(), since these actions will automatically occur during
2596    the call to TSStep() or TSSolve().  However, if one wishes to control this
2597    phase separately, TSSetUp() should be called after TSCreate()
2598    and optional routines of the form TSSetXXX(), but before TSStep() and TSSolve().
2599 
2600    Level: advanced
2601 
2602 .keywords: TS, timestep, setup
2603 
2604 .seealso: TSCreate(), TSStep(), TSDestroy(), TSSolve()
2605 @*/
2606 PetscErrorCode  TSSetUp(TS ts)
2607 {
2608   PetscErrorCode ierr;
2609   DM             dm;
2610   PetscErrorCode (*func)(SNES,Vec,Vec,void*);
2611   PetscErrorCode (*jac)(SNES,Vec,Mat,Mat,void*);
2612   TSIFunction    ifun;
2613   TSIJacobian    ijac;
2614   TSI2Jacobian   i2jac;
2615   TSRHSJacobian  rhsjac;
2616   PetscBool      isnone;
2617 
2618   PetscFunctionBegin;
2619   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2620   if (ts->setupcalled) PetscFunctionReturn(0);
2621 
2622   if (!((PetscObject)ts)->type_name) {
2623     ierr = TSGetIFunction(ts,NULL,&ifun,NULL);CHKERRQ(ierr);
2624     ierr = TSSetType(ts,ifun ? TSBEULER : TSEULER);CHKERRQ(ierr);
2625   }
2626 
2627   if (!ts->vec_sol) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call TSSetSolution() first");
2628 
2629   if (ts->rhsjacobian.reuse) {
2630     Mat Amat,Pmat;
2631     SNES snes;
2632     ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
2633     ierr = SNESGetJacobian(snes,&Amat,&Pmat,NULL,NULL);CHKERRQ(ierr);
2634     /* Matching matrices implies that an IJacobian is NOT set, because if it had been set, the IJacobian's matrix would
2635      * have displaced the RHS matrix */
2636     if (Amat == ts->Arhs) {
2637       /* we need to copy the values of the matrix because for the constant Jacobian case the user will never set the numerical values in this new location */
2638       ierr = MatDuplicate(ts->Arhs,MAT_COPY_VALUES,&Amat);CHKERRQ(ierr);
2639       ierr = SNESSetJacobian(snes,Amat,NULL,NULL,NULL);CHKERRQ(ierr);
2640       ierr = MatDestroy(&Amat);CHKERRQ(ierr);
2641     }
2642     if (Pmat == ts->Brhs) {
2643       ierr = MatDuplicate(ts->Brhs,MAT_COPY_VALUES,&Pmat);CHKERRQ(ierr);
2644       ierr = SNESSetJacobian(snes,NULL,Pmat,NULL,NULL);CHKERRQ(ierr);
2645       ierr = MatDestroy(&Pmat);CHKERRQ(ierr);
2646     }
2647   }
2648 
2649   ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
2650   ierr = TSAdaptSetDefaultType(ts->adapt,ts->default_adapt_type);CHKERRQ(ierr);
2651 
2652   if (ts->ops->setup) {
2653     ierr = (*ts->ops->setup)(ts);CHKERRQ(ierr);
2654   }
2655 
2656   /* Attempt to check/preset a default value for the exact final time option */
2657   ierr = PetscObjectTypeCompare((PetscObject)ts->adapt,TSADAPTNONE,&isnone);CHKERRQ(ierr);
2658   if (!isnone && ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED)
2659     ts->exact_final_time = TS_EXACTFINALTIME_MATCHSTEP;
2660 
2661   /* In the case where we've set a DMTSFunction or what have you, we need the default SNESFunction
2662      to be set right but can't do it elsewhere due to the overreliance on ctx=ts.
2663    */
2664   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
2665   ierr = DMSNESGetFunction(dm,&func,NULL);CHKERRQ(ierr);
2666   if (!func) {
2667     ierr = DMSNESSetFunction(dm,SNESTSFormFunction,ts);CHKERRQ(ierr);
2668   }
2669   /* If the SNES doesn't have a jacobian set and the TS has an ijacobian or rhsjacobian set, set the SNES to use it.
2670      Otherwise, the SNES will use coloring internally to form the Jacobian.
2671    */
2672   ierr = DMSNESGetJacobian(dm,&jac,NULL);CHKERRQ(ierr);
2673   ierr = DMTSGetIJacobian(dm,&ijac,NULL);CHKERRQ(ierr);
2674   ierr = DMTSGetI2Jacobian(dm,&i2jac,NULL);CHKERRQ(ierr);
2675   ierr = DMTSGetRHSJacobian(dm,&rhsjac,NULL);CHKERRQ(ierr);
2676   if (!jac && (ijac || i2jac || rhsjac)) {
2677     ierr = DMSNESSetJacobian(dm,SNESTSFormJacobian,ts);CHKERRQ(ierr);
2678   }
2679 
2680   /* if time integration scheme has a starting method, call it */
2681   if (ts->ops->startingmethod) {
2682     ierr = (*ts->ops->startingmethod)(ts);CHKERRQ(ierr);
2683   }
2684 
2685   ts->setupcalled = PETSC_TRUE;
2686   PetscFunctionReturn(0);
2687 }
2688 
2689 /*@
2690    TSAdjointSetUp - Sets up the internal data structures for the later use
2691    of an adjoint solver
2692 
2693    Collective on TS
2694 
2695    Input Parameter:
2696 .  ts - the TS context obtained from TSCreate()
2697 
2698    Level: advanced
2699 
2700 .keywords: TS, timestep, setup
2701 
2702 .seealso: TSCreate(), TSAdjointStep(), TSSetCostGradients()
2703 @*/
2704 PetscErrorCode  TSAdjointSetUp(TS ts)
2705 {
2706   PetscErrorCode ierr;
2707 
2708   PetscFunctionBegin;
2709   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2710   if (ts->adjointsetupcalled) PetscFunctionReturn(0);
2711   if (!ts->vecs_sensi) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"Must call TSSetCostGradients() first");
2712   if (ts->vecs_sensip && !ts->Jacp) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"Must call TSAdjointSetRHSJacobian() first");
2713 
2714   if (ts->vec_costintegral) { /* if there is integral in the cost function */
2715     ierr = VecDuplicateVecs(ts->vecs_sensi[0],ts->numcost,&ts->vecs_drdy);CHKERRQ(ierr);
2716     if (ts->vecs_sensip){
2717       ierr = VecDuplicateVecs(ts->vecs_sensip[0],ts->numcost,&ts->vecs_drdp);CHKERRQ(ierr);
2718     }
2719   }
2720 
2721   if (ts->ops->adjointsetup) {
2722     ierr = (*ts->ops->adjointsetup)(ts);CHKERRQ(ierr);
2723   }
2724   ts->adjointsetupcalled = PETSC_TRUE;
2725   PetscFunctionReturn(0);
2726 }
2727 
2728 /*@
2729    TSReset - Resets a TS context and removes any allocated Vecs and Mats.
2730 
2731    Collective on TS
2732 
2733    Input Parameter:
2734 .  ts - the TS context obtained from TSCreate()
2735 
2736    Level: beginner
2737 
2738 .keywords: TS, timestep, reset
2739 
2740 .seealso: TSCreate(), TSSetup(), TSDestroy()
2741 @*/
2742 PetscErrorCode  TSReset(TS ts)
2743 {
2744   PetscErrorCode ierr;
2745 
2746   PetscFunctionBegin;
2747   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2748 
2749   if (ts->ops->reset) {
2750     ierr = (*ts->ops->reset)(ts);CHKERRQ(ierr);
2751   }
2752   if (ts->snes) {ierr = SNESReset(ts->snes);CHKERRQ(ierr);}
2753   if (ts->adapt) {ierr = TSAdaptReset(ts->adapt);CHKERRQ(ierr);}
2754 
2755   ierr = MatDestroy(&ts->Arhs);CHKERRQ(ierr);
2756   ierr = MatDestroy(&ts->Brhs);CHKERRQ(ierr);
2757   ierr = VecDestroy(&ts->Frhs);CHKERRQ(ierr);
2758   ierr = VecDestroy(&ts->vec_sol);CHKERRQ(ierr);
2759   ierr = VecDestroy(&ts->vec_dot);CHKERRQ(ierr);
2760   ierr = VecDestroy(&ts->vatol);CHKERRQ(ierr);
2761   ierr = VecDestroy(&ts->vrtol);CHKERRQ(ierr);
2762   ierr = VecDestroyVecs(ts->nwork,&ts->work);CHKERRQ(ierr);
2763 
2764   ierr = VecDestroyVecs(ts->numcost,&ts->vecs_drdy);CHKERRQ(ierr);
2765   ierr = VecDestroyVecs(ts->numcost,&ts->vecs_drdp);CHKERRQ(ierr);
2766 
2767   ierr = MatDestroy(&ts->Jacp);CHKERRQ(ierr);
2768   ierr = VecDestroy(&ts->vec_costintegral);CHKERRQ(ierr);
2769   ierr = VecDestroy(&ts->vec_costintegrand);CHKERRQ(ierr);
2770 
2771   ierr = PetscFree(ts->vecs_fwdsensipacked);CHKERRQ(ierr);
2772 
2773   ts->setupcalled = PETSC_FALSE;
2774   PetscFunctionReturn(0);
2775 }
2776 
2777 /*@
2778    TSDestroy - Destroys the timestepper context that was created
2779    with TSCreate().
2780 
2781    Collective on TS
2782 
2783    Input Parameter:
2784 .  ts - the TS context obtained from TSCreate()
2785 
2786    Level: beginner
2787 
2788 .keywords: TS, timestepper, destroy
2789 
2790 .seealso: TSCreate(), TSSetUp(), TSSolve()
2791 @*/
2792 PetscErrorCode  TSDestroy(TS *ts)
2793 {
2794   PetscErrorCode ierr;
2795 
2796   PetscFunctionBegin;
2797   if (!*ts) PetscFunctionReturn(0);
2798   PetscValidHeaderSpecific((*ts),TS_CLASSID,1);
2799   if (--((PetscObject)(*ts))->refct > 0) {*ts = 0; PetscFunctionReturn(0);}
2800 
2801   ierr = TSReset((*ts));CHKERRQ(ierr);
2802 
2803   /* if memory was published with SAWs then destroy it */
2804   ierr = PetscObjectSAWsViewOff((PetscObject)*ts);CHKERRQ(ierr);
2805   if ((*ts)->ops->destroy) {ierr = (*(*ts)->ops->destroy)((*ts));CHKERRQ(ierr);}
2806 
2807   ierr = TSTrajectoryDestroy(&(*ts)->trajectory);CHKERRQ(ierr);
2808 
2809   ierr = TSAdaptDestroy(&(*ts)->adapt);CHKERRQ(ierr);
2810   ierr = TSEventDestroy(&(*ts)->event);CHKERRQ(ierr);
2811 
2812   ierr = SNESDestroy(&(*ts)->snes);CHKERRQ(ierr);
2813   ierr = DMDestroy(&(*ts)->dm);CHKERRQ(ierr);
2814   ierr = TSMonitorCancel((*ts));CHKERRQ(ierr);
2815   ierr = TSAdjointMonitorCancel((*ts));CHKERRQ(ierr);
2816 
2817   ierr = PetscHeaderDestroy(ts);CHKERRQ(ierr);
2818   PetscFunctionReturn(0);
2819 }
2820 
2821 /*@
2822    TSGetSNES - Returns the SNES (nonlinear solver) associated with
2823    a TS (timestepper) context. Valid only for nonlinear problems.
2824 
2825    Not Collective, but SNES is parallel if TS is parallel
2826 
2827    Input Parameter:
2828 .  ts - the TS context obtained from TSCreate()
2829 
2830    Output Parameter:
2831 .  snes - the nonlinear solver context
2832 
2833    Notes:
2834    The user can then directly manipulate the SNES context to set various
2835    options, etc.  Likewise, the user can then extract and manipulate the
2836    KSP, KSP, and PC contexts as well.
2837 
2838    TSGetSNES() does not work for integrators that do not use SNES; in
2839    this case TSGetSNES() returns NULL in snes.
2840 
2841    Level: beginner
2842 
2843 .keywords: timestep, get, SNES
2844 @*/
2845 PetscErrorCode  TSGetSNES(TS ts,SNES *snes)
2846 {
2847   PetscErrorCode ierr;
2848 
2849   PetscFunctionBegin;
2850   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2851   PetscValidPointer(snes,2);
2852   if (!ts->snes) {
2853     ierr = SNESCreate(PetscObjectComm((PetscObject)ts),&ts->snes);CHKERRQ(ierr);
2854     ierr = SNESSetFunction(ts->snes,NULL,SNESTSFormFunction,ts);CHKERRQ(ierr);
2855     ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)ts->snes);CHKERRQ(ierr);
2856     ierr = PetscObjectIncrementTabLevel((PetscObject)ts->snes,(PetscObject)ts,1);CHKERRQ(ierr);
2857     if (ts->dm) {ierr = SNESSetDM(ts->snes,ts->dm);CHKERRQ(ierr);}
2858     if (ts->problem_type == TS_LINEAR) {
2859       ierr = SNESSetType(ts->snes,SNESKSPONLY);CHKERRQ(ierr);
2860     }
2861   }
2862   *snes = ts->snes;
2863   PetscFunctionReturn(0);
2864 }
2865 
2866 /*@
2867    TSSetSNES - Set the SNES (nonlinear solver) to be used by the timestepping context
2868 
2869    Collective
2870 
2871    Input Parameter:
2872 +  ts - the TS context obtained from TSCreate()
2873 -  snes - the nonlinear solver context
2874 
2875    Notes:
2876    Most users should have the TS created by calling TSGetSNES()
2877 
2878    Level: developer
2879 
2880 .keywords: timestep, set, SNES
2881 @*/
2882 PetscErrorCode TSSetSNES(TS ts,SNES snes)
2883 {
2884   PetscErrorCode ierr;
2885   PetscErrorCode (*func)(SNES,Vec,Mat,Mat,void*);
2886 
2887   PetscFunctionBegin;
2888   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2889   PetscValidHeaderSpecific(snes,SNES_CLASSID,2);
2890   ierr = PetscObjectReference((PetscObject)snes);CHKERRQ(ierr);
2891   ierr = SNESDestroy(&ts->snes);CHKERRQ(ierr);
2892 
2893   ts->snes = snes;
2894 
2895   ierr = SNESSetFunction(ts->snes,NULL,SNESTSFormFunction,ts);CHKERRQ(ierr);
2896   ierr = SNESGetJacobian(ts->snes,NULL,NULL,&func,NULL);CHKERRQ(ierr);
2897   if (func == SNESTSFormJacobian) {
2898     ierr = SNESSetJacobian(ts->snes,NULL,NULL,SNESTSFormJacobian,ts);CHKERRQ(ierr);
2899   }
2900   PetscFunctionReturn(0);
2901 }
2902 
2903 /*@
2904    TSGetKSP - Returns the KSP (linear solver) associated with
2905    a TS (timestepper) context.
2906 
2907    Not Collective, but KSP is parallel if TS is parallel
2908 
2909    Input Parameter:
2910 .  ts - the TS context obtained from TSCreate()
2911 
2912    Output Parameter:
2913 .  ksp - the nonlinear solver context
2914 
2915    Notes:
2916    The user can then directly manipulate the KSP context to set various
2917    options, etc.  Likewise, the user can then extract and manipulate the
2918    KSP and PC contexts as well.
2919 
2920    TSGetKSP() does not work for integrators that do not use KSP;
2921    in this case TSGetKSP() returns NULL in ksp.
2922 
2923    Level: beginner
2924 
2925 .keywords: timestep, get, KSP
2926 @*/
2927 PetscErrorCode  TSGetKSP(TS ts,KSP *ksp)
2928 {
2929   PetscErrorCode ierr;
2930   SNES           snes;
2931 
2932   PetscFunctionBegin;
2933   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2934   PetscValidPointer(ksp,2);
2935   if (!((PetscObject)ts)->type_name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"KSP is not created yet. Call TSSetType() first");
2936   if (ts->problem_type != TS_LINEAR) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Linear only; use TSGetSNES()");
2937   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
2938   ierr = SNESGetKSP(snes,ksp);CHKERRQ(ierr);
2939   PetscFunctionReturn(0);
2940 }
2941 
2942 /* ----------- Routines to set solver parameters ---------- */
2943 
2944 /*@
2945    TSSetMaxSteps - Sets the maximum number of steps to use.
2946 
2947    Logically Collective on TS
2948 
2949    Input Parameters:
2950 +  ts - the TS context obtained from TSCreate()
2951 -  maxsteps - maximum number of steps to use
2952 
2953    Options Database Keys:
2954 .  -ts_max_steps <maxsteps> - Sets maxsteps
2955 
2956    Notes:
2957    The default maximum number of steps is 5000
2958 
2959    Level: intermediate
2960 
2961 .keywords: TS, timestep, set, maximum, steps
2962 
2963 .seealso: TSGetMaxSteps(), TSSetMaxTime(), TSSetExactFinalTime()
2964 @*/
2965 PetscErrorCode TSSetMaxSteps(TS ts,PetscInt maxsteps)
2966 {
2967   PetscFunctionBegin;
2968   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2969   PetscValidLogicalCollectiveInt(ts,maxsteps,2);
2970   if (maxsteps < 0 ) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_OUTOFRANGE,"Maximum number of steps must be non-negative");
2971   ts->max_steps = maxsteps;
2972   PetscFunctionReturn(0);
2973 }
2974 
2975 /*@
2976    TSGetMaxSteps - Gets the maximum number of steps to use.
2977 
2978    Not Collective
2979 
2980    Input Parameters:
2981 .  ts - the TS context obtained from TSCreate()
2982 
2983    Output Parameter:
2984 .  maxsteps - maximum number of steps to use
2985 
2986    Level: advanced
2987 
2988 .keywords: TS, timestep, get, maximum, steps
2989 
2990 .seealso: TSSetMaxSteps(), TSGetMaxTime(), TSSetMaxTime()
2991 @*/
2992 PetscErrorCode TSGetMaxSteps(TS ts,PetscInt *maxsteps)
2993 {
2994   PetscFunctionBegin;
2995   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
2996   PetscValidIntPointer(maxsteps,2);
2997   *maxsteps = ts->max_steps;
2998   PetscFunctionReturn(0);
2999 }
3000 
3001 /*@
3002    TSSetMaxTime - Sets the maximum (or final) time for timestepping.
3003 
3004    Logically Collective on TS
3005 
3006    Input Parameters:
3007 +  ts - the TS context obtained from TSCreate()
3008 -  maxtime - final time to step to
3009 
3010    Options Database Keys:
3011 .  -ts_max_time <maxtime> - Sets maxtime
3012 
3013    Notes:
3014    The default maximum time is 5.0
3015 
3016    Level: intermediate
3017 
3018 .keywords: TS, timestep, set, maximum, time
3019 
3020 .seealso: TSGetMaxTime(), TSSetMaxSteps(), TSSetExactFinalTime()
3021 @*/
3022 PetscErrorCode TSSetMaxTime(TS ts,PetscReal maxtime)
3023 {
3024   PetscFunctionBegin;
3025   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3026   PetscValidLogicalCollectiveReal(ts,maxtime,2);
3027   ts->max_time = maxtime;
3028   PetscFunctionReturn(0);
3029 }
3030 
3031 /*@
3032    TSGetMaxTime - Gets the maximum (or final) time for timestepping.
3033 
3034    Not Collective
3035 
3036    Input Parameters:
3037 .  ts - the TS context obtained from TSCreate()
3038 
3039    Output Parameter:
3040 .  maxtime - final time to step to
3041 
3042    Level: advanced
3043 
3044 .keywords: TS, timestep, get, maximum, time
3045 
3046 .seealso: TSSetMaxTime(), TSGetMaxSteps(), TSSetMaxSteps()
3047 @*/
3048 PetscErrorCode TSGetMaxTime(TS ts,PetscReal *maxtime)
3049 {
3050   PetscFunctionBegin;
3051   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3052   PetscValidRealPointer(maxtime,2);
3053   *maxtime = ts->max_time;
3054   PetscFunctionReturn(0);
3055 }
3056 
3057 /*@
3058    TSSetInitialTimeStep - Deprecated, use TSSetTime() and TSSetTimeStep().
3059 
3060    Level: deprecated
3061 
3062 @*/
3063 PetscErrorCode  TSSetInitialTimeStep(TS ts,PetscReal initial_time,PetscReal time_step)
3064 {
3065   PetscErrorCode ierr;
3066   PetscFunctionBegin;
3067   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3068   ierr = TSSetTime(ts,initial_time);CHKERRQ(ierr);
3069   ierr = TSSetTimeStep(ts,time_step);CHKERRQ(ierr);
3070   PetscFunctionReturn(0);
3071 }
3072 
3073 /*@
3074    TSGetDuration - Deprecated, use TSGetMaxSteps() and TSGetMaxTime().
3075 
3076    Level: deprecated
3077 
3078 @*/
3079 PetscErrorCode TSGetDuration(TS ts, PetscInt *maxsteps, PetscReal *maxtime)
3080 {
3081   PetscFunctionBegin;
3082   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3083   if (maxsteps) {
3084     PetscValidIntPointer(maxsteps,2);
3085     *maxsteps = ts->max_steps;
3086   }
3087   if (maxtime) {
3088     PetscValidScalarPointer(maxtime,3);
3089     *maxtime = ts->max_time;
3090   }
3091   PetscFunctionReturn(0);
3092 }
3093 
3094 /*@
3095    TSSetDuration - Deprecated, use TSSetMaxSteps() and TSSetMaxTime().
3096 
3097    Level: deprecated
3098 
3099 @*/
3100 PetscErrorCode TSSetDuration(TS ts,PetscInt maxsteps,PetscReal maxtime)
3101 {
3102   PetscFunctionBegin;
3103   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3104   PetscValidLogicalCollectiveInt(ts,maxsteps,2);
3105   PetscValidLogicalCollectiveReal(ts,maxtime,2);
3106   if (maxsteps >= 0) ts->max_steps = maxsteps;
3107   if (maxtime != PETSC_DEFAULT) ts->max_time = maxtime;
3108   PetscFunctionReturn(0);
3109 }
3110 
3111 /*@
3112    TSGetTimeStepNumber - Deprecated, use TSGetStepNumber().
3113 
3114    Level: deprecated
3115 
3116 @*/
3117 PetscErrorCode TSGetTimeStepNumber(TS ts,PetscInt *steps) { return TSGetStepNumber(ts,steps); }
3118 
3119 /*@
3120    TSGetTotalSteps - Deprecated, use TSGetStepNumber().
3121 
3122    Level: deprecated
3123 
3124 @*/
3125 PetscErrorCode TSGetTotalSteps(TS ts,PetscInt *steps) { return TSGetStepNumber(ts,steps); }
3126 
3127 /*@
3128    TSSetSolution - Sets the initial solution vector
3129    for use by the TS routines.
3130 
3131    Logically Collective on TS and Vec
3132 
3133    Input Parameters:
3134 +  ts - the TS context obtained from TSCreate()
3135 -  u - the solution vector
3136 
3137    Level: beginner
3138 
3139 .keywords: TS, timestep, set, solution, initial values
3140 
3141 .seealso: TSSetSolutionFunction(), TSGetSolution(), TSCreate()
3142 @*/
3143 PetscErrorCode  TSSetSolution(TS ts,Vec u)
3144 {
3145   PetscErrorCode ierr;
3146   DM             dm;
3147 
3148   PetscFunctionBegin;
3149   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3150   PetscValidHeaderSpecific(u,VEC_CLASSID,2);
3151   ierr = PetscObjectReference((PetscObject)u);CHKERRQ(ierr);
3152   ierr = VecDestroy(&ts->vec_sol);CHKERRQ(ierr);
3153   ts->vec_sol = u;
3154 
3155   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
3156   ierr = DMShellSetGlobalVector(dm,u);CHKERRQ(ierr);
3157   PetscFunctionReturn(0);
3158 }
3159 
3160 /*@
3161    TSAdjointSetSteps - Sets the number of steps the adjoint solver should take backward in time
3162 
3163    Logically Collective on TS
3164 
3165    Input Parameters:
3166 +  ts - the TS context obtained from TSCreate()
3167 .  steps - number of steps to use
3168 
3169    Level: intermediate
3170 
3171    Notes: Normally one does not call this and TSAdjointSolve() integrates back to the original timestep. One can call this
3172           so as to integrate back to less than the original timestep
3173 
3174 .keywords: TS, timestep, set, maximum, iterations
3175 
3176 .seealso: TSSetExactFinalTime()
3177 @*/
3178 PetscErrorCode  TSAdjointSetSteps(TS ts,PetscInt steps)
3179 {
3180   PetscFunctionBegin;
3181   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3182   PetscValidLogicalCollectiveInt(ts,steps,2);
3183   if (steps < 0) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_OUTOFRANGE,"Cannot step back a negative number of steps");
3184   if (steps > ts->steps) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_OUTOFRANGE,"Cannot step back more than the total number of forward steps");
3185   ts->adjoint_max_steps = steps;
3186   PetscFunctionReturn(0);
3187 }
3188 
3189 /*@
3190    TSSetCostGradients - Sets the initial value of the gradients of the cost function w.r.t. initial values and w.r.t. the problem parameters
3191       for use by the TSAdjoint routines.
3192 
3193    Logically Collective on TS and Vec
3194 
3195    Input Parameters:
3196 +  ts - the TS context obtained from TSCreate()
3197 .  lambda - gradients with respect to the initial condition variables, the dimension and parallel layout of these vectors is the same as the ODE solution vector
3198 -  mu - gradients with respect to the parameters, the number of entries in these vectors is the same as the number of parameters
3199 
3200    Level: beginner
3201 
3202    Notes: the entries in these vectors must be correctly initialized with the values lamda_i = df/dy|finaltime  mu_i = df/dp|finaltime
3203 
3204    After TSAdjointSolve() is called the lamba and the mu contain the computed sensitivities
3205 
3206 .keywords: TS, timestep, set, sensitivity, initial values
3207 @*/
3208 PetscErrorCode  TSSetCostGradients(TS ts,PetscInt numcost,Vec *lambda,Vec *mu)
3209 {
3210   PetscFunctionBegin;
3211   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3212   PetscValidPointer(lambda,2);
3213   ts->vecs_sensi  = lambda;
3214   ts->vecs_sensip = mu;
3215   if (ts->numcost && ts->numcost!=numcost) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"The number of cost functions (2rd parameter of TSSetCostIntegrand()) is inconsistent with the one set by TSSetCostIntegrand");
3216   ts->numcost  = numcost;
3217   PetscFunctionReturn(0);
3218 }
3219 
3220 /*@C
3221   TSAdjointSetRHSJacobian - Sets the function that computes the Jacobian of G w.r.t. the parameters p where y_t = G(y,p,t), as well as the location to store the matrix.
3222 
3223   Logically Collective on TS
3224 
3225   Input Parameters:
3226 + ts   - The TS context obtained from TSCreate()
3227 - func - The function
3228 
3229   Calling sequence of func:
3230 $ func (TS ts,PetscReal t,Vec y,Mat A,void *ctx);
3231 +   t - current timestep
3232 .   y - input vector (current ODE solution)
3233 .   A - output matrix
3234 -   ctx - [optional] user-defined function context
3235 
3236   Level: intermediate
3237 
3238   Notes: Amat has the same number of rows and the same row parallel layout as u, Amat has the same number of columns and parallel layout as p
3239 
3240 .keywords: TS, sensitivity
3241 .seealso:
3242 @*/
3243 PetscErrorCode  TSAdjointSetRHSJacobian(TS ts,Mat Amat,PetscErrorCode (*func)(TS,PetscReal,Vec,Mat,void*),void *ctx)
3244 {
3245   PetscErrorCode ierr;
3246 
3247   PetscFunctionBegin;
3248   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3249   PetscValidHeaderSpecific(Amat,MAT_CLASSID,2);
3250 
3251   ts->rhsjacobianp    = func;
3252   ts->rhsjacobianpctx = ctx;
3253   if(Amat) {
3254     ierr = PetscObjectReference((PetscObject)Amat);CHKERRQ(ierr);
3255     ierr = MatDestroy(&ts->Jacp);CHKERRQ(ierr);
3256     ts->Jacp = Amat;
3257   }
3258   PetscFunctionReturn(0);
3259 }
3260 
3261 /*@C
3262   TSAdjointComputeRHSJacobian - Runs the user-defined Jacobian function.
3263 
3264   Collective on TS
3265 
3266   Input Parameters:
3267 . ts   - The TS context obtained from TSCreate()
3268 
3269   Level: developer
3270 
3271 .keywords: TS, sensitivity
3272 .seealso: TSAdjointSetRHSJacobian()
3273 @*/
3274 PetscErrorCode  TSAdjointComputeRHSJacobian(TS ts,PetscReal t,Vec X,Mat Amat)
3275 {
3276   PetscErrorCode ierr;
3277 
3278   PetscFunctionBegin;
3279   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3280   PetscValidHeaderSpecific(X,VEC_CLASSID,3);
3281   PetscValidPointer(Amat,4);
3282 
3283   PetscStackPush("TS user JacobianP function for sensitivity analysis");
3284   ierr = (*ts->rhsjacobianp)(ts,t,X,Amat,ts->rhsjacobianpctx); CHKERRQ(ierr);
3285   PetscStackPop;
3286   PetscFunctionReturn(0);
3287 }
3288 
3289 /*@C
3290     TSSetCostIntegrand - Sets the routine for evaluating the integral term in one or more cost functions
3291 
3292     Logically Collective on TS
3293 
3294     Input Parameters:
3295 +   ts - the TS context obtained from TSCreate()
3296 .   numcost - number of gradients to be computed, this is the number of cost functions
3297 .   costintegral - vector that stores the integral values
3298 .   rf - routine for evaluating the integrand function
3299 .   drdyf - function that computes the gradients of the r's with respect to y,NULL if not a function y
3300 .   drdpf - function that computes the gradients of the r's with respect to p, NULL if not a function of p
3301 .   fwd - flag indicating whether to evaluate cost integral in the forward run or the adjoint run
3302 -   ctx - [optional] user-defined context for private data for the function evaluation routine (may be NULL)
3303 
3304     Calling sequence of rf:
3305 $   PetscErrorCode rf(TS ts,PetscReal t,Vec y,Vec f,void *ctx);
3306 
3307     Calling sequence of drdyf:
3308 $   PetscErroCode drdyf(TS ts,PetscReal t,Vec y,Vec *drdy,void *ctx);
3309 
3310     Calling sequence of drdpf:
3311 $   PetscErroCode drdpf(TS ts,PetscReal t,Vec y,Vec *drdp,void *ctx);
3312 
3313     Level: intermediate
3314 
3315     Notes: For optimization there is usually a single cost function (numcost = 1). For sensitivities there may be multiple cost functions
3316 
3317 .keywords: TS, sensitivity analysis, timestep, set, quadrature, function
3318 
3319 .seealso: TSAdjointSetRHSJacobian(),TSGetCostGradients(), TSSetCostGradients()
3320 @*/
3321 PetscErrorCode  TSSetCostIntegrand(TS ts,PetscInt numcost,Vec costintegral,PetscErrorCode (*rf)(TS,PetscReal,Vec,Vec,void*),
3322                                                           PetscErrorCode (*drdyf)(TS,PetscReal,Vec,Vec*,void*),
3323                                                           PetscErrorCode (*drdpf)(TS,PetscReal,Vec,Vec*,void*),
3324                                                           PetscBool fwd,void *ctx)
3325 {
3326   PetscErrorCode ierr;
3327 
3328   PetscFunctionBegin;
3329   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3330   if (costintegral) PetscValidHeaderSpecific(costintegral,VEC_CLASSID,3);
3331   if (ts->numcost && ts->numcost!=numcost) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"The number of cost functions (2rd parameter of TSSetCostIntegrand()) is inconsistent with the one set by TSSetCostGradients() or TSForwardSetIntegralGradients()");
3332   if (!ts->numcost) ts->numcost=numcost;
3333 
3334   if (costintegral) {
3335     ierr = PetscObjectReference((PetscObject)costintegral);CHKERRQ(ierr);
3336     ierr = VecDestroy(&ts->vec_costintegral);CHKERRQ(ierr);
3337     ts->vec_costintegral = costintegral;
3338   } else {
3339     if (!ts->vec_costintegral) { /* Create a seq vec if user does not provide one */
3340       ierr = VecCreateSeq(PETSC_COMM_SELF,numcost,&ts->vec_costintegral);CHKERRQ(ierr);
3341     } else {
3342       ierr = VecSet(ts->vec_costintegral,0.0);CHKERRQ(ierr);
3343     }
3344   }
3345   if (!ts->vec_costintegrand) {
3346     ierr = VecDuplicate(ts->vec_costintegral,&ts->vec_costintegrand);CHKERRQ(ierr);
3347   } else {
3348     ierr = VecSet(ts->vec_costintegrand,0.0);CHKERRQ(ierr);
3349   }
3350   ts->costintegralfwd  = fwd; /* Evaluate the cost integral in forward run if fwd is true */
3351   ts->costintegrand    = rf;
3352   ts->costintegrandctx = ctx;
3353   ts->drdyfunction     = drdyf;
3354   ts->drdpfunction     = drdpf;
3355   PetscFunctionReturn(0);
3356 }
3357 
3358 /*@
3359    TSGetCostIntegral - Returns the values of the integral term in the cost functions.
3360    It is valid to call the routine after a backward run.
3361 
3362    Not Collective
3363 
3364    Input Parameter:
3365 .  ts - the TS context obtained from TSCreate()
3366 
3367    Output Parameter:
3368 .  v - the vector containing the integrals for each cost function
3369 
3370    Level: intermediate
3371 
3372 .seealso: TSSetCostIntegrand()
3373 
3374 .keywords: TS, sensitivity analysis
3375 @*/
3376 PetscErrorCode  TSGetCostIntegral(TS ts,Vec *v)
3377 {
3378   PetscFunctionBegin;
3379   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3380   PetscValidPointer(v,2);
3381   *v = ts->vec_costintegral;
3382   PetscFunctionReturn(0);
3383 }
3384 
3385 /*@
3386    TSComputeCostIntegrand - Evaluates the integral function in the cost functions.
3387 
3388    Input Parameters:
3389 +  ts - the TS context
3390 .  t - current time
3391 -  y - state vector, i.e. current solution
3392 
3393    Output Parameter:
3394 .  q - vector of size numcost to hold the outputs
3395 
3396    Note:
3397    Most users should not need to explicitly call this routine, as it
3398    is used internally within the sensitivity analysis context.
3399 
3400    Level: developer
3401 
3402 .keywords: TS, compute
3403 
3404 .seealso: TSSetCostIntegrand()
3405 @*/
3406 PetscErrorCode TSComputeCostIntegrand(TS ts,PetscReal t,Vec y,Vec q)
3407 {
3408   PetscErrorCode ierr;
3409 
3410   PetscFunctionBegin;
3411   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3412   PetscValidHeaderSpecific(y,VEC_CLASSID,3);
3413   PetscValidHeaderSpecific(q,VEC_CLASSID,4);
3414 
3415   ierr = PetscLogEventBegin(TS_FunctionEval,ts,y,q,0);CHKERRQ(ierr);
3416   if (ts->costintegrand) {
3417     PetscStackPush("TS user integrand in the cost function");
3418     ierr = (*ts->costintegrand)(ts,t,y,q,ts->costintegrandctx);CHKERRQ(ierr);
3419     PetscStackPop;
3420   } else {
3421     ierr = VecZeroEntries(q);CHKERRQ(ierr);
3422   }
3423 
3424   ierr = PetscLogEventEnd(TS_FunctionEval,ts,y,q,0);CHKERRQ(ierr);
3425   PetscFunctionReturn(0);
3426 }
3427 
3428 /*@
3429   TSAdjointComputeDRDYFunction - Runs the user-defined DRDY function.
3430 
3431   Collective on TS
3432 
3433   Input Parameters:
3434 . ts   - The TS context obtained from TSCreate()
3435 
3436   Notes:
3437   TSAdjointComputeDRDYFunction() is typically used for sensitivity implementation,
3438   so most users would not generally call this routine themselves.
3439 
3440   Level: developer
3441 
3442 .keywords: TS, sensitivity
3443 .seealso: TSAdjointComputeDRDYFunction()
3444 @*/
3445 PetscErrorCode  TSAdjointComputeDRDYFunction(TS ts,PetscReal t,Vec y,Vec *drdy)
3446 {
3447   PetscErrorCode ierr;
3448 
3449   PetscFunctionBegin;
3450   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3451   PetscValidHeaderSpecific(y,VEC_CLASSID,3);
3452 
3453   PetscStackPush("TS user DRDY function for sensitivity analysis");
3454   ierr = (*ts->drdyfunction)(ts,t,y,drdy,ts->costintegrandctx); CHKERRQ(ierr);
3455   PetscStackPop;
3456   PetscFunctionReturn(0);
3457 }
3458 
3459 /*@
3460   TSAdjointComputeDRDPFunction - Runs the user-defined DRDP function.
3461 
3462   Collective on TS
3463 
3464   Input Parameters:
3465 . ts   - The TS context obtained from TSCreate()
3466 
3467   Notes:
3468   TSDRDPFunction() is typically used for sensitivity implementation,
3469   so most users would not generally call this routine themselves.
3470 
3471   Level: developer
3472 
3473 .keywords: TS, sensitivity
3474 .seealso: TSAdjointSetDRDPFunction()
3475 @*/
3476 PetscErrorCode  TSAdjointComputeDRDPFunction(TS ts,PetscReal t,Vec y,Vec *drdp)
3477 {
3478   PetscErrorCode ierr;
3479 
3480   PetscFunctionBegin;
3481   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3482   PetscValidHeaderSpecific(y,VEC_CLASSID,3);
3483 
3484   PetscStackPush("TS user DRDP function for sensitivity analysis");
3485   ierr = (*ts->drdpfunction)(ts,t,y,drdp,ts->costintegrandctx); CHKERRQ(ierr);
3486   PetscStackPop;
3487   PetscFunctionReturn(0);
3488 }
3489 
3490 /*@C
3491   TSSetPreStep - Sets the general-purpose function
3492   called once at the beginning of each time step.
3493 
3494   Logically Collective on TS
3495 
3496   Input Parameters:
3497 + ts   - The TS context obtained from TSCreate()
3498 - func - The function
3499 
3500   Calling sequence of func:
3501 . func (TS ts);
3502 
3503   Level: intermediate
3504 
3505 .keywords: TS, timestep
3506 .seealso: TSSetPreStage(), TSSetPostStage(), TSSetPostStep(), TSStep(), TSRestartStep()
3507 @*/
3508 PetscErrorCode  TSSetPreStep(TS ts, PetscErrorCode (*func)(TS))
3509 {
3510   PetscFunctionBegin;
3511   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3512   ts->prestep = func;
3513   PetscFunctionReturn(0);
3514 }
3515 
3516 /*@
3517   TSPreStep - Runs the user-defined pre-step function.
3518 
3519   Collective on TS
3520 
3521   Input Parameters:
3522 . ts   - The TS context obtained from TSCreate()
3523 
3524   Notes:
3525   TSPreStep() is typically used within time stepping implementations,
3526   so most users would not generally call this routine themselves.
3527 
3528   Level: developer
3529 
3530 .keywords: TS, timestep
3531 .seealso: TSSetPreStep(), TSPreStage(), TSPostStage(), TSPostStep()
3532 @*/
3533 PetscErrorCode  TSPreStep(TS ts)
3534 {
3535   PetscErrorCode ierr;
3536 
3537   PetscFunctionBegin;
3538   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3539   if (ts->prestep) {
3540     Vec              U;
3541     PetscObjectState sprev,spost;
3542 
3543     ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
3544     ierr = PetscObjectStateGet((PetscObject)U,&sprev);CHKERRQ(ierr);
3545     PetscStackCallStandard((*ts->prestep),(ts));
3546     ierr = PetscObjectStateGet((PetscObject)U,&spost);CHKERRQ(ierr);
3547     if (sprev != spost) {ierr = TSRestartStep(ts);CHKERRQ(ierr);}
3548   }
3549   PetscFunctionReturn(0);
3550 }
3551 
3552 /*@C
3553   TSSetPreStage - Sets the general-purpose function
3554   called once at the beginning of each stage.
3555 
3556   Logically Collective on TS
3557 
3558   Input Parameters:
3559 + ts   - The TS context obtained from TSCreate()
3560 - func - The function
3561 
3562   Calling sequence of func:
3563 . PetscErrorCode func(TS ts, PetscReal stagetime);
3564 
3565   Level: intermediate
3566 
3567   Note:
3568   There may be several stages per time step. If the solve for a given stage fails, the step may be rejected and retried.
3569   The time step number being computed can be queried using TSGetStepNumber() and the total size of the step being
3570   attempted can be obtained using TSGetTimeStep(). The time at the start of the step is available via TSGetTime().
3571 
3572 .keywords: TS, timestep
3573 .seealso: TSSetPostStage(), TSSetPreStep(), TSSetPostStep(), TSGetApplicationContext()
3574 @*/
3575 PetscErrorCode  TSSetPreStage(TS ts, PetscErrorCode (*func)(TS,PetscReal))
3576 {
3577   PetscFunctionBegin;
3578   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3579   ts->prestage = func;
3580   PetscFunctionReturn(0);
3581 }
3582 
3583 /*@C
3584   TSSetPostStage - Sets the general-purpose function
3585   called once at the end of each stage.
3586 
3587   Logically Collective on TS
3588 
3589   Input Parameters:
3590 + ts   - The TS context obtained from TSCreate()
3591 - func - The function
3592 
3593   Calling sequence of func:
3594 . PetscErrorCode func(TS ts, PetscReal stagetime, PetscInt stageindex, Vec* Y);
3595 
3596   Level: intermediate
3597 
3598   Note:
3599   There may be several stages per time step. If the solve for a given stage fails, the step may be rejected and retried.
3600   The time step number being computed can be queried using TSGetStepNumber() and the total size of the step being
3601   attempted can be obtained using TSGetTimeStep(). The time at the start of the step is available via TSGetTime().
3602 
3603 .keywords: TS, timestep
3604 .seealso: TSSetPreStage(), TSSetPreStep(), TSSetPostStep(), TSGetApplicationContext()
3605 @*/
3606 PetscErrorCode  TSSetPostStage(TS ts, PetscErrorCode (*func)(TS,PetscReal,PetscInt,Vec*))
3607 {
3608   PetscFunctionBegin;
3609   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3610   ts->poststage = func;
3611   PetscFunctionReturn(0);
3612 }
3613 
3614 /*@C
3615   TSSetPostEvaluate - Sets the general-purpose function
3616   called once at the end of each step evaluation.
3617 
3618   Logically Collective on TS
3619 
3620   Input Parameters:
3621 + ts   - The TS context obtained from TSCreate()
3622 - func - The function
3623 
3624   Calling sequence of func:
3625 . PetscErrorCode func(TS ts);
3626 
3627   Level: intermediate
3628 
3629   Note:
3630   Semantically, TSSetPostEvaluate() differs from TSSetPostStep() since the function it sets is called before event-handling
3631   thus guaranteeing the same solution (computed by the time-stepper) will be passed to it. On the other hand, TSPostStep()
3632   may be passed a different solution, possibly changed by the event handler. TSPostEvaluate() is called after the next step
3633   solution is evaluated allowing to modify it, if need be. The solution can be obtained with TSGetSolution(), the time step
3634   with TSGetTimeStep(), and the time at the start of the step is available via TSGetTime()
3635 
3636 .keywords: TS, timestep
3637 .seealso: TSSetPreStage(), TSSetPreStep(), TSSetPostStep(), TSGetApplicationContext()
3638 @*/
3639 PetscErrorCode  TSSetPostEvaluate(TS ts, PetscErrorCode (*func)(TS))
3640 {
3641   PetscFunctionBegin;
3642   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3643   ts->postevaluate = func;
3644   PetscFunctionReturn(0);
3645 }
3646 
3647 /*@
3648   TSPreStage - Runs the user-defined pre-stage function set using TSSetPreStage()
3649 
3650   Collective on TS
3651 
3652   Input Parameters:
3653 . ts          - The TS context obtained from TSCreate()
3654   stagetime   - The absolute time of the current stage
3655 
3656   Notes:
3657   TSPreStage() is typically used within time stepping implementations,
3658   most users would not generally call this routine themselves.
3659 
3660   Level: developer
3661 
3662 .keywords: TS, timestep
3663 .seealso: TSPostStage(), TSSetPreStep(), TSPreStep(), TSPostStep()
3664 @*/
3665 PetscErrorCode  TSPreStage(TS ts, PetscReal stagetime)
3666 {
3667   PetscErrorCode ierr;
3668 
3669   PetscFunctionBegin;
3670   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3671   if (ts->prestage) {
3672     PetscStackCallStandard((*ts->prestage),(ts,stagetime));
3673   }
3674   PetscFunctionReturn(0);
3675 }
3676 
3677 /*@
3678   TSPostStage - Runs the user-defined post-stage function set using TSSetPostStage()
3679 
3680   Collective on TS
3681 
3682   Input Parameters:
3683 . ts          - The TS context obtained from TSCreate()
3684   stagetime   - The absolute time of the current stage
3685   stageindex  - Stage number
3686   Y           - Array of vectors (of size = total number
3687                 of stages) with the stage solutions
3688 
3689   Notes:
3690   TSPostStage() is typically used within time stepping implementations,
3691   most users would not generally call this routine themselves.
3692 
3693   Level: developer
3694 
3695 .keywords: TS, timestep
3696 .seealso: TSPreStage(), TSSetPreStep(), TSPreStep(), TSPostStep()
3697 @*/
3698 PetscErrorCode  TSPostStage(TS ts, PetscReal stagetime, PetscInt stageindex, Vec *Y)
3699 {
3700   PetscErrorCode ierr;
3701 
3702   PetscFunctionBegin;
3703   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3704   if (ts->poststage) {
3705     PetscStackCallStandard((*ts->poststage),(ts,stagetime,stageindex,Y));
3706   }
3707   PetscFunctionReturn(0);
3708 }
3709 
3710 /*@
3711   TSPostEvaluate - Runs the user-defined post-evaluate function set using TSSetPostEvaluate()
3712 
3713   Collective on TS
3714 
3715   Input Parameters:
3716 . ts          - The TS context obtained from TSCreate()
3717 
3718   Notes:
3719   TSPostEvaluate() is typically used within time stepping implementations,
3720   most users would not generally call this routine themselves.
3721 
3722   Level: developer
3723 
3724 .keywords: TS, timestep
3725 .seealso: TSSetPostEvaluate(), TSSetPreStep(), TSPreStep(), TSPostStep()
3726 @*/
3727 PetscErrorCode  TSPostEvaluate(TS ts)
3728 {
3729   PetscErrorCode ierr;
3730 
3731   PetscFunctionBegin;
3732   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3733   if (ts->postevaluate) {
3734     Vec              U;
3735     PetscObjectState sprev,spost;
3736 
3737     ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
3738     ierr = PetscObjectStateGet((PetscObject)U,&sprev);CHKERRQ(ierr);
3739     PetscStackCallStandard((*ts->postevaluate),(ts));
3740     ierr = PetscObjectStateGet((PetscObject)U,&spost);CHKERRQ(ierr);
3741     if (sprev != spost) {ierr = TSRestartStep(ts);CHKERRQ(ierr);}
3742   }
3743   PetscFunctionReturn(0);
3744 }
3745 
3746 /*@C
3747   TSSetPostStep - Sets the general-purpose function
3748   called once at the end of each time step.
3749 
3750   Logically Collective on TS
3751 
3752   Input Parameters:
3753 + ts   - The TS context obtained from TSCreate()
3754 - func - The function
3755 
3756   Calling sequence of func:
3757 $ func (TS ts);
3758 
3759   Notes:
3760   The function set by TSSetPostStep() is called after each successful step. The solution vector X
3761   obtained by TSGetSolution() may be different than that computed at the step end if the event handler
3762   locates an event and TSPostEvent() modifies it. Use TSSetPostEvaluate() if an unmodified solution is needed instead.
3763 
3764   Level: intermediate
3765 
3766 .keywords: TS, timestep
3767 .seealso: TSSetPreStep(), TSSetPreStage(), TSSetPostEvaluate(), TSGetTimeStep(), TSGetStepNumber(), TSGetTime(), TSRestartStep()
3768 @*/
3769 PetscErrorCode  TSSetPostStep(TS ts, PetscErrorCode (*func)(TS))
3770 {
3771   PetscFunctionBegin;
3772   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
3773   ts->poststep = func;
3774   PetscFunctionReturn(0);
3775 }
3776 
3777 /*@
3778   TSPostStep - Runs the user-defined post-step function.
3779 
3780   Collective on TS
3781 
3782   Input Parameters:
3783 . ts   - The TS context obtained from TSCreate()
3784 
3785   Notes:
3786   TSPostStep() is typically used within time stepping implementations,
3787   so most users would not generally call this routine themselves.
3788 
3789   Level: developer
3790 
3791 .keywords: TS, timestep
3792 @*/
3793 PetscErrorCode  TSPostStep(TS ts)
3794 {
3795   PetscErrorCode ierr;
3796 
3797   PetscFunctionBegin;
3798   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3799   if (ts->poststep) {
3800     Vec              U;
3801     PetscObjectState sprev,spost;
3802 
3803     ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
3804     ierr = PetscObjectStateGet((PetscObject)U,&sprev);CHKERRQ(ierr);
3805     PetscStackCallStandard((*ts->poststep),(ts));
3806     ierr = PetscObjectStateGet((PetscObject)U,&spost);CHKERRQ(ierr);
3807     if (sprev != spost) {ierr = TSRestartStep(ts);CHKERRQ(ierr);}
3808   }
3809   PetscFunctionReturn(0);
3810 }
3811 
3812 /* ------------ Routines to set performance monitoring options ----------- */
3813 
3814 /*@C
3815    TSMonitorSet - Sets an ADDITIONAL function that is to be used at every
3816    timestep to display the iteration's  progress.
3817 
3818    Logically Collective on TS
3819 
3820    Input Parameters:
3821 +  ts - the TS context obtained from TSCreate()
3822 .  monitor - monitoring routine
3823 .  mctx - [optional] user-defined context for private data for the
3824              monitor routine (use NULL if no context is desired)
3825 -  monitordestroy - [optional] routine that frees monitor context
3826           (may be NULL)
3827 
3828    Calling sequence of monitor:
3829 $    PetscErrorCode monitor(TS ts,PetscInt steps,PetscReal time,Vec u,void *mctx)
3830 
3831 +    ts - the TS context
3832 .    steps - iteration number (after the final time step the monitor routine may be called with a step of -1, this indicates the solution has been interpolated to this time)
3833 .    time - current time
3834 .    u - current iterate
3835 -    mctx - [optional] monitoring context
3836 
3837    Notes:
3838    This routine adds an additional monitor to the list of monitors that
3839    already has been loaded.
3840 
3841    Fortran notes: Only a single monitor function can be set for each TS object
3842 
3843    Level: intermediate
3844 
3845 .keywords: TS, timestep, set, monitor
3846 
3847 .seealso: TSMonitorDefault(), TSMonitorCancel()
3848 @*/
3849 PetscErrorCode  TSMonitorSet(TS ts,PetscErrorCode (*monitor)(TS,PetscInt,PetscReal,Vec,void*),void *mctx,PetscErrorCode (*mdestroy)(void**))
3850 {
3851   PetscErrorCode ierr;
3852   PetscInt       i;
3853   PetscBool      identical;
3854 
3855   PetscFunctionBegin;
3856   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3857   for (i=0; i<ts->numbermonitors;i++) {
3858     ierr = PetscMonitorCompare((PetscErrorCode (*)(void))monitor,mctx,mdestroy,(PetscErrorCode (*)(void))ts->monitor[i],ts->monitorcontext[i],ts->monitordestroy[i],&identical);CHKERRQ(ierr);
3859     if (identical) PetscFunctionReturn(0);
3860   }
3861   if (ts->numbermonitors >= MAXTSMONITORS) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Too many monitors set");
3862   ts->monitor[ts->numbermonitors]          = monitor;
3863   ts->monitordestroy[ts->numbermonitors]   = mdestroy;
3864   ts->monitorcontext[ts->numbermonitors++] = (void*)mctx;
3865   PetscFunctionReturn(0);
3866 }
3867 
3868 /*@C
3869    TSMonitorCancel - Clears all the monitors that have been set on a time-step object.
3870 
3871    Logically Collective on TS
3872 
3873    Input Parameters:
3874 .  ts - the TS context obtained from TSCreate()
3875 
3876    Notes:
3877    There is no way to remove a single, specific monitor.
3878 
3879    Level: intermediate
3880 
3881 .keywords: TS, timestep, set, monitor
3882 
3883 .seealso: TSMonitorDefault(), TSMonitorSet()
3884 @*/
3885 PetscErrorCode  TSMonitorCancel(TS ts)
3886 {
3887   PetscErrorCode ierr;
3888   PetscInt       i;
3889 
3890   PetscFunctionBegin;
3891   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3892   for (i=0; i<ts->numbermonitors; i++) {
3893     if (ts->monitordestroy[i]) {
3894       ierr = (*ts->monitordestroy[i])(&ts->monitorcontext[i]);CHKERRQ(ierr);
3895     }
3896   }
3897   ts->numbermonitors = 0;
3898   PetscFunctionReturn(0);
3899 }
3900 
3901 /*@C
3902    TSMonitorDefault - The Default monitor, prints the timestep and time for each step
3903 
3904    Level: intermediate
3905 
3906 .keywords: TS, set, monitor
3907 
3908 .seealso:  TSMonitorSet()
3909 @*/
3910 PetscErrorCode TSMonitorDefault(TS ts,PetscInt step,PetscReal ptime,Vec v,PetscViewerAndFormat *vf)
3911 {
3912   PetscErrorCode ierr;
3913   PetscViewer    viewer =  vf->viewer;
3914   PetscBool      iascii,ibinary;
3915 
3916   PetscFunctionBegin;
3917   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,4);
3918   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
3919   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&ibinary);CHKERRQ(ierr);
3920   ierr = PetscViewerPushFormat(viewer,vf->format);CHKERRQ(ierr);
3921   if (iascii) {
3922     ierr = PetscViewerASCIIAddTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
3923     if (step == -1){ /* this indicates it is an interpolated solution */
3924       ierr = PetscViewerASCIIPrintf(viewer,"Interpolated solution at time %g between steps %D and %D\n",(double)ptime,ts->steps-1,ts->steps);CHKERRQ(ierr);
3925     } else {
3926       ierr = PetscViewerASCIIPrintf(viewer,"%D TS dt %g time %g%s",step,(double)ts->time_step,(double)ptime,ts->steprollback ? " (r)\n" : "\n");CHKERRQ(ierr);
3927     }
3928     ierr = PetscViewerASCIISubtractTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
3929   } else if (ibinary) {
3930     PetscMPIInt rank;
3931     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)viewer),&rank);CHKERRQ(ierr);
3932     if (!rank) {
3933       PetscBool skipHeader;
3934       PetscInt  classid = REAL_FILE_CLASSID;
3935 
3936       ierr = PetscViewerBinaryGetSkipHeader(viewer,&skipHeader);CHKERRQ(ierr);
3937       if (!skipHeader) {
3938          ierr = PetscViewerBinaryWrite(viewer,&classid,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
3939        }
3940       ierr = PetscRealView(1,&ptime,viewer);CHKERRQ(ierr);
3941     } else {
3942       ierr = PetscRealView(0,&ptime,viewer);CHKERRQ(ierr);
3943     }
3944   }
3945   ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
3946   PetscFunctionReturn(0);
3947 }
3948 
3949 /*@C
3950    TSAdjointMonitorSet - Sets an ADDITIONAL function that is to be used at every
3951    timestep to display the iteration's  progress.
3952 
3953    Logically Collective on TS
3954 
3955    Input Parameters:
3956 +  ts - the TS context obtained from TSCreate()
3957 .  adjointmonitor - monitoring routine
3958 .  adjointmctx - [optional] user-defined context for private data for the
3959              monitor routine (use NULL if no context is desired)
3960 -  adjointmonitordestroy - [optional] routine that frees monitor context
3961           (may be NULL)
3962 
3963    Calling sequence of monitor:
3964 $    int adjointmonitor(TS ts,PetscInt steps,PetscReal time,Vec u,PetscInt numcost,Vec *lambda, Vec *mu,void *adjointmctx)
3965 
3966 +    ts - the TS context
3967 .    steps - iteration number (after the final time step the monitor routine is called with a step of -1, this is at the final time which may have
3968                                been interpolated to)
3969 .    time - current time
3970 .    u - current iterate
3971 .    numcost - number of cost functionos
3972 .    lambda - sensitivities to initial conditions
3973 .    mu - sensitivities to parameters
3974 -    adjointmctx - [optional] adjoint monitoring context
3975 
3976    Notes:
3977    This routine adds an additional monitor to the list of monitors that
3978    already has been loaded.
3979 
3980    Fortran notes: Only a single monitor function can be set for each TS object
3981 
3982    Level: intermediate
3983 
3984 .keywords: TS, timestep, set, adjoint, monitor
3985 
3986 .seealso: TSAdjointMonitorCancel()
3987 @*/
3988 PetscErrorCode  TSAdjointMonitorSet(TS ts,PetscErrorCode (*adjointmonitor)(TS,PetscInt,PetscReal,Vec,PetscInt,Vec*,Vec*,void*),void *adjointmctx,PetscErrorCode (*adjointmdestroy)(void**))
3989 {
3990   PetscErrorCode ierr;
3991   PetscInt       i;
3992   PetscBool      identical;
3993 
3994   PetscFunctionBegin;
3995   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
3996   for (i=0; i<ts->numbermonitors;i++) {
3997     ierr = PetscMonitorCompare((PetscErrorCode (*)(void))adjointmonitor,adjointmctx,adjointmdestroy,(PetscErrorCode (*)(void))ts->adjointmonitor[i],ts->adjointmonitorcontext[i],ts->adjointmonitordestroy[i],&identical);CHKERRQ(ierr);
3998     if (identical) PetscFunctionReturn(0);
3999   }
4000   if (ts->numberadjointmonitors >= MAXTSMONITORS) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Too many adjoint monitors set");
4001   ts->adjointmonitor[ts->numberadjointmonitors]          = adjointmonitor;
4002   ts->adjointmonitordestroy[ts->numberadjointmonitors]   = adjointmdestroy;
4003   ts->adjointmonitorcontext[ts->numberadjointmonitors++] = (void*)adjointmctx;
4004   PetscFunctionReturn(0);
4005 }
4006 
4007 /*@C
4008    TSAdjointMonitorCancel - Clears all the adjoint monitors that have been set on a time-step object.
4009 
4010    Logically Collective on TS
4011 
4012    Input Parameters:
4013 .  ts - the TS context obtained from TSCreate()
4014 
4015    Notes:
4016    There is no way to remove a single, specific monitor.
4017 
4018    Level: intermediate
4019 
4020 .keywords: TS, timestep, set, adjoint, monitor
4021 
4022 .seealso: TSAdjointMonitorSet()
4023 @*/
4024 PetscErrorCode  TSAdjointMonitorCancel(TS ts)
4025 {
4026   PetscErrorCode ierr;
4027   PetscInt       i;
4028 
4029   PetscFunctionBegin;
4030   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4031   for (i=0; i<ts->numberadjointmonitors; i++) {
4032     if (ts->adjointmonitordestroy[i]) {
4033       ierr = (*ts->adjointmonitordestroy[i])(&ts->adjointmonitorcontext[i]);CHKERRQ(ierr);
4034     }
4035   }
4036   ts->numberadjointmonitors = 0;
4037   PetscFunctionReturn(0);
4038 }
4039 
4040 /*@C
4041    TSAdjointMonitorDefault - the default monitor of adjoint computations
4042 
4043    Level: intermediate
4044 
4045 .keywords: TS, set, monitor
4046 
4047 .seealso: TSAdjointMonitorSet()
4048 @*/
4049 PetscErrorCode TSAdjointMonitorDefault(TS ts,PetscInt step,PetscReal ptime,Vec v,PetscInt numcost,Vec *lambda,Vec *mu,PetscViewerAndFormat *vf)
4050 {
4051   PetscErrorCode ierr;
4052   PetscViewer    viewer = vf->viewer;
4053 
4054   PetscFunctionBegin;
4055   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,4);
4056   ierr = PetscViewerPushFormat(viewer,vf->format);CHKERRQ(ierr);
4057   ierr = PetscViewerASCIIAddTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
4058   ierr = PetscViewerASCIIPrintf(viewer,"%D TS dt %g time %g%s",step,(double)ts->time_step,(double)ptime,ts->steprollback ? " (r)\n" : "\n");CHKERRQ(ierr);
4059   ierr = PetscViewerASCIISubtractTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
4060   ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
4061   PetscFunctionReturn(0);
4062 }
4063 
4064 /*@
4065    TSInterpolate - Interpolate the solution computed during the previous step to an arbitrary location in the interval
4066 
4067    Collective on TS
4068 
4069    Input Argument:
4070 +  ts - time stepping context
4071 -  t - time to interpolate to
4072 
4073    Output Argument:
4074 .  U - state at given time
4075 
4076    Level: intermediate
4077 
4078    Developer Notes:
4079    TSInterpolate() and the storing of previous steps/stages should be generalized to support delay differential equations and continuous adjoints.
4080 
4081 .keywords: TS, set
4082 
4083 .seealso: TSSetExactFinalTime(), TSSolve()
4084 @*/
4085 PetscErrorCode TSInterpolate(TS ts,PetscReal t,Vec U)
4086 {
4087   PetscErrorCode ierr;
4088 
4089   PetscFunctionBegin;
4090   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4091   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
4092   if (t < ts->ptime_prev || t > ts->ptime) SETERRQ3(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_OUTOFRANGE,"Requested time %g not in last time steps [%g,%g]",t,(double)ts->ptime_prev,(double)ts->ptime);
4093   if (!ts->ops->interpolate) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"%s does not provide interpolation",((PetscObject)ts)->type_name);
4094   ierr = (*ts->ops->interpolate)(ts,t,U);CHKERRQ(ierr);
4095   PetscFunctionReturn(0);
4096 }
4097 
4098 /*@
4099    TSStep - Steps one time step
4100 
4101    Collective on TS
4102 
4103    Input Parameter:
4104 .  ts - the TS context obtained from TSCreate()
4105 
4106    Level: developer
4107 
4108    Notes:
4109    The public interface for the ODE/DAE solvers is TSSolve(), you should almost for sure be using that routine and not this routine.
4110 
4111    The hook set using TSSetPreStep() is called before each attempt to take the step. In general, the time step size may
4112    be changed due to adaptive error controller or solve failures. Note that steps may contain multiple stages.
4113 
4114    This may over-step the final time provided in TSSetMaxTime() depending on the time-step used. TSSolve() interpolates to exactly the
4115    time provided in TSSetMaxTime(). One can use TSInterpolate() to determine an interpolated solution within the final timestep.
4116 
4117 .keywords: TS, timestep, solve
4118 
4119 .seealso: TSCreate(), TSSetUp(), TSDestroy(), TSSolve(), TSSetPreStep(), TSSetPreStage(), TSSetPostStage(), TSInterpolate()
4120 @*/
4121 PetscErrorCode  TSStep(TS ts)
4122 {
4123   PetscErrorCode   ierr;
4124   static PetscBool cite = PETSC_FALSE;
4125   PetscReal        ptime;
4126 
4127   PetscFunctionBegin;
4128   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4129   ierr = PetscCitationsRegister("@techreport{tspaper,\n"
4130                                 "  title       = {{PETSc/TS}: A Modern Scalable {DAE/ODE} Solver Library},\n"
4131                                 "  author      = {Shrirang Abhyankar and Jed Brown and Emil Constantinescu and Debojyoti Ghosh and Barry F. Smith},\n"
4132                                 "  type        = {Preprint},\n"
4133                                 "  number      = {ANL/MCS-P5061-0114},\n"
4134                                 "  institution = {Argonne National Laboratory},\n"
4135                                 "  year        = {2014}\n}\n",&cite);CHKERRQ(ierr);
4136 
4137   ierr = TSSetUp(ts);CHKERRQ(ierr);
4138   ierr = TSTrajectorySetUp(ts->trajectory,ts);CHKERRQ(ierr);
4139 
4140   if (ts->max_time >= PETSC_MAX_REAL && ts->max_steps == PETSC_MAX_INT) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"You must call TSSetMaxTime() or TSSetMaxSteps(), or use -ts_max_time <time> or -ts_max_steps <steps>");
4141   if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"You must call TSSetExactFinalTime() or use -ts_exact_final_time <stepover,interpolate,matchstep> before calling TSStep()");
4142   if (ts->exact_final_time == TS_EXACTFINALTIME_MATCHSTEP && !ts->adapt) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Since TS is not adaptive you cannot use TS_EXACTFINALTIME_MATCHSTEP, suggest TS_EXACTFINALTIME_INTERPOLATE");
4143 
4144   if (!ts->steps) ts->ptime_prev = ts->ptime;
4145   ptime = ts->ptime; ts->ptime_prev_rollback = ts->ptime_prev;
4146   ts->reason = TS_CONVERGED_ITERATING;
4147   if (!ts->ops->step) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSStep not implemented for type '%s'",((PetscObject)ts)->type_name);
4148   ierr = PetscLogEventBegin(TS_Step,ts,0,0,0);CHKERRQ(ierr);
4149   ierr = (*ts->ops->step)(ts);CHKERRQ(ierr);
4150   ierr = PetscLogEventEnd(TS_Step,ts,0,0,0);CHKERRQ(ierr);
4151   ts->ptime_prev = ptime;
4152   ts->steps++;
4153   ts->steprollback = PETSC_FALSE;
4154   ts->steprestart  = PETSC_FALSE;
4155 
4156   if (ts->reason < 0) {
4157     if (ts->errorifstepfailed) {
4158       if (ts->reason == TS_DIVERGED_NONLINEAR_SOLVE) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed due to %s, increase -ts_max_snes_failures or make negative to attempt recovery",TSConvergedReasons[ts->reason]);
4159       else SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed due to %s",TSConvergedReasons[ts->reason]);
4160     }
4161   } else if (!ts->reason) {
4162     if (ts->steps >= ts->max_steps) ts->reason = TS_CONVERGED_ITS;
4163     else if (ts->ptime >= ts->max_time) ts->reason = TS_CONVERGED_TIME;
4164   }
4165   PetscFunctionReturn(0);
4166 }
4167 
4168 /*@
4169    TSAdjointStep - Steps one time step backward in the adjoint run
4170 
4171    Collective on TS
4172 
4173    Input Parameter:
4174 .  ts - the TS context obtained from TSCreate()
4175 
4176    Level: intermediate
4177 
4178 .keywords: TS, adjoint, step
4179 
4180 .seealso: TSAdjointSetUp(), TSAdjointSolve()
4181 @*/
4182 PetscErrorCode  TSAdjointStep(TS ts)
4183 {
4184   DM               dm;
4185   PetscErrorCode   ierr;
4186 
4187   PetscFunctionBegin;
4188   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4189   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
4190   ierr = TSAdjointSetUp(ts);CHKERRQ(ierr);
4191 
4192   ierr = VecViewFromOptions(ts->vec_sol,(PetscObject)ts,"-ts_view_solution");CHKERRQ(ierr);
4193 
4194   ts->reason = TS_CONVERGED_ITERATING;
4195   ts->ptime_prev = ts->ptime;
4196   if (!ts->ops->adjointstep) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed because the adjoint of  %s has not been implemented, try other time stepping methods for adjoint sensitivity analysis",((PetscObject)ts)->type_name);
4197   ierr = PetscLogEventBegin(TS_AdjointStep,ts,0,0,0);CHKERRQ(ierr);
4198   ierr = (*ts->ops->adjointstep)(ts);CHKERRQ(ierr);
4199   ierr = PetscLogEventEnd(TS_AdjointStep,ts,0,0,0);CHKERRQ(ierr);
4200   ts->adjoint_steps++; ts->steps--;
4201 
4202   if (ts->reason < 0) {
4203     if (ts->errorifstepfailed) {
4204       if (ts->reason == TS_DIVERGED_NONLINEAR_SOLVE) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed due to %s, increase -ts_max_snes_failures or make negative to attempt recovery",TSConvergedReasons[ts->reason]);
4205       else if (ts->reason == TS_DIVERGED_STEP_REJECTED) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed due to %s, increase -ts_max_reject or make negative to attempt recovery",TSConvergedReasons[ts->reason]);
4206       else SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_NOT_CONVERGED,"TSStep has failed due to %s",TSConvergedReasons[ts->reason]);
4207     }
4208   } else if (!ts->reason) {
4209     if (ts->adjoint_steps >= ts->adjoint_max_steps) ts->reason = TS_CONVERGED_ITS;
4210   }
4211   PetscFunctionReturn(0);
4212 }
4213 
4214 /*@
4215    TSEvaluateWLTE - Evaluate the weighted local truncation error norm
4216    at the end of a time step with a given order of accuracy.
4217 
4218    Collective on TS
4219 
4220    Input Arguments:
4221 +  ts - time stepping context
4222 .  wnormtype - norm type, either NORM_2 or NORM_INFINITY
4223 -  order - optional, desired order for the error evaluation or PETSC_DECIDE
4224 
4225    Output Arguments:
4226 +  order - optional, the actual order of the error evaluation
4227 -  wlte - the weighted local truncation error norm
4228 
4229    Level: advanced
4230 
4231    Notes:
4232    If the timestepper cannot evaluate the error in a particular step
4233    (eg. in the first step or restart steps after event handling),
4234    this routine returns wlte=-1.0 .
4235 
4236 .seealso: TSStep(), TSAdapt, TSErrorWeightedNorm()
4237 @*/
4238 PetscErrorCode TSEvaluateWLTE(TS ts,NormType wnormtype,PetscInt *order,PetscReal *wlte)
4239 {
4240   PetscErrorCode ierr;
4241 
4242   PetscFunctionBegin;
4243   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4244   PetscValidType(ts,1);
4245   PetscValidLogicalCollectiveEnum(ts,wnormtype,4);
4246   if (order) PetscValidIntPointer(order,3);
4247   if (order) PetscValidLogicalCollectiveInt(ts,*order,3);
4248   PetscValidRealPointer(wlte,4);
4249   if (wnormtype != NORM_2 && wnormtype != NORM_INFINITY) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"No support for norm type %s",NormTypes[wnormtype]);
4250   if (!ts->ops->evaluatewlte) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSEvaluateWLTE not implemented for type '%s'",((PetscObject)ts)->type_name);
4251   ierr = (*ts->ops->evaluatewlte)(ts,wnormtype,order,wlte);CHKERRQ(ierr);
4252   PetscFunctionReturn(0);
4253 }
4254 
4255 /*@
4256    TSEvaluateStep - Evaluate the solution at the end of a time step with a given order of accuracy.
4257 
4258    Collective on TS
4259 
4260    Input Arguments:
4261 +  ts - time stepping context
4262 .  order - desired order of accuracy
4263 -  done - whether the step was evaluated at this order (pass NULL to generate an error if not available)
4264 
4265    Output Arguments:
4266 .  U - state at the end of the current step
4267 
4268    Level: advanced
4269 
4270    Notes:
4271    This function cannot be called until all stages have been evaluated.
4272    It is normally called by adaptive controllers before a step has been accepted and may also be called by the user after TSStep() has returned.
4273 
4274 .seealso: TSStep(), TSAdapt
4275 @*/
4276 PetscErrorCode TSEvaluateStep(TS ts,PetscInt order,Vec U,PetscBool *done)
4277 {
4278   PetscErrorCode ierr;
4279 
4280   PetscFunctionBegin;
4281   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4282   PetscValidType(ts,1);
4283   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
4284   if (!ts->ops->evaluatestep) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSEvaluateStep not implemented for type '%s'",((PetscObject)ts)->type_name);
4285   ierr = (*ts->ops->evaluatestep)(ts,order,U,done);CHKERRQ(ierr);
4286   PetscFunctionReturn(0);
4287 }
4288 
4289 /*@
4290    TSForwardCostIntegral - Evaluate the cost integral in the forward run.
4291 
4292    Collective on TS
4293 
4294    Input Arguments:
4295 .  ts - time stepping context
4296 
4297    Level: advanced
4298 
4299    Notes:
4300    This function cannot be called until TSStep() has been completed.
4301 
4302 .seealso: TSSolve(), TSAdjointCostIntegral()
4303 @*/
4304 PetscErrorCode TSForwardCostIntegral(TS ts)
4305 {
4306   PetscErrorCode ierr;
4307   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4308   if (!ts->ops->forwardintegral) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"%s does not provide integral evaluation in the forward run",((PetscObject)ts)->type_name);
4309   ierr = (*ts->ops->forwardintegral)(ts);CHKERRQ(ierr);
4310   PetscFunctionReturn(0);
4311 }
4312 
4313 /*@
4314    TSSolve - Steps the requested number of timesteps.
4315 
4316    Collective on TS
4317 
4318    Input Parameter:
4319 +  ts - the TS context obtained from TSCreate()
4320 -  u - the solution vector  (can be null if TSSetSolution() was used and TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP) was not used,
4321                              otherwise must contain the initial conditions and will contain the solution at the final requested time
4322 
4323    Level: beginner
4324 
4325    Notes:
4326    The final time returned by this function may be different from the time of the internally
4327    held state accessible by TSGetSolution() and TSGetTime() because the method may have
4328    stepped over the final time.
4329 
4330 .keywords: TS, timestep, solve
4331 
4332 .seealso: TSCreate(), TSSetSolution(), TSStep(), TSGetTime(), TSGetSolveTime()
4333 @*/
4334 PetscErrorCode TSSolve(TS ts,Vec u)
4335 {
4336   Vec               solution;
4337   PetscErrorCode    ierr;
4338 
4339   PetscFunctionBegin;
4340   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4341   if (u) PetscValidHeaderSpecific(u,VEC_CLASSID,2);
4342 
4343   if (ts->exact_final_time == TS_EXACTFINALTIME_INTERPOLATE && u) {   /* Need ts->vec_sol to be distinct so it is not overwritten when we interpolate at the end */
4344     if (!ts->vec_sol || u == ts->vec_sol) {
4345       ierr = VecDuplicate(u,&solution);CHKERRQ(ierr);
4346       ierr = TSSetSolution(ts,solution);CHKERRQ(ierr);
4347       ierr = VecDestroy(&solution);CHKERRQ(ierr); /* grant ownership */
4348     }
4349     ierr = VecCopy(u,ts->vec_sol);CHKERRQ(ierr);
4350     if (ts->forward_solve) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Sensitivity analysis does not support the mode TS_EXACTFINALTIME_INTERPOLATE");
4351   } else if (u) {
4352     ierr = TSSetSolution(ts,u);CHKERRQ(ierr);
4353   }
4354   ierr = TSSetUp(ts);CHKERRQ(ierr);
4355   ierr = TSTrajectorySetUp(ts->trajectory,ts);CHKERRQ(ierr);
4356 
4357   if (ts->max_time >= PETSC_MAX_REAL && ts->max_steps == PETSC_MAX_INT) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"You must call TSSetMaxTime() or TSSetMaxSteps(), or use -ts_max_time <time> or -ts_max_steps <steps>");
4358   if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"You must call TSSetExactFinalTime() or use -ts_exact_final_time <stepover,interpolate,matchstep> before calling TSSolve()");
4359   if (ts->exact_final_time == TS_EXACTFINALTIME_MATCHSTEP && !ts->adapt) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Since TS is not adaptive you cannot use TS_EXACTFINALTIME_MATCHSTEP, suggest TS_EXACTFINALTIME_INTERPOLATE");
4360 
4361   if (ts->forward_solve) {
4362     ierr = TSForwardSetUp(ts);CHKERRQ(ierr);
4363   }
4364 
4365   /* reset number of steps only when the step is not restarted. ARKIMEX
4366      restarts the step after an event. Resetting these counters in such case causes
4367      TSTrajectory to incorrectly save the output files
4368   */
4369   /* reset time step and iteration counters */
4370   if (!ts->steps) {
4371     ts->ksp_its           = 0;
4372     ts->snes_its          = 0;
4373     ts->num_snes_failures = 0;
4374     ts->reject            = 0;
4375     ts->steprestart       = PETSC_TRUE;
4376     ts->steprollback      = PETSC_FALSE;
4377   }
4378   if (ts->exact_final_time == TS_EXACTFINALTIME_MATCHSTEP && ts->ptime + ts->time_step > ts->max_time) ts->time_step = ts->max_time - ts->ptime;
4379   ts->reason = TS_CONVERGED_ITERATING;
4380 
4381   ierr = TSViewFromOptions(ts,NULL,"-ts_view_pre");CHKERRQ(ierr);
4382 
4383   if (ts->ops->solve) { /* This private interface is transitional and should be removed when all implementations are updated. */
4384     ierr = (*ts->ops->solve)(ts);CHKERRQ(ierr);
4385     if (u) {ierr = VecCopy(ts->vec_sol,u);CHKERRQ(ierr);}
4386     ts->solvetime = ts->ptime;
4387     solution = ts->vec_sol;
4388   } else { /* Step the requested number of timesteps. */
4389     if (ts->steps >= ts->max_steps) ts->reason = TS_CONVERGED_ITS;
4390     else if (ts->ptime >= ts->max_time) ts->reason = TS_CONVERGED_TIME;
4391 
4392     if (!ts->steps) {
4393       ierr = TSTrajectorySet(ts->trajectory,ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
4394       ierr = TSEventInitialize(ts->event,ts,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
4395     }
4396 
4397     while (!ts->reason) {
4398       ierr = TSMonitor(ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
4399       if (!ts->steprollback) {
4400         ierr = TSPreStep(ts);CHKERRQ(ierr);
4401       }
4402       ierr = TSStep(ts);CHKERRQ(ierr);
4403       if (ts->testjacobian) {
4404         ierr = TSRHSJacobianTest(ts,NULL);CHKERRQ(ierr);
4405       }
4406       if (ts->testjacobiantranspose) {
4407         ierr = TSRHSJacobianTestTranspose(ts,NULL);CHKERRQ(ierr);
4408       }
4409       if (ts->vec_costintegral && ts->costintegralfwd) { /* Must evaluate the cost integral before event is handled. The cost integral value can also be rolled back. */
4410         ierr = TSForwardCostIntegral(ts);CHKERRQ(ierr);
4411       }
4412       if (ts->forward_solve) { /* compute forward sensitivities before event handling because postevent() may change RHS and jump conditions may have to be applied */
4413         ierr = TSForwardStep(ts);CHKERRQ(ierr);
4414       }
4415       ierr = TSPostEvaluate(ts);CHKERRQ(ierr);
4416       ierr = TSEventHandler(ts);CHKERRQ(ierr); /* The right-hand side may be changed due to event. Be careful with Any computation using the RHS information after this point. */
4417       if (ts->steprollback) {
4418         ierr = TSPostEvaluate(ts);CHKERRQ(ierr);
4419       }
4420       if (!ts->steprollback) {
4421         ierr = TSTrajectorySet(ts->trajectory,ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
4422         ierr = TSPostStep(ts);CHKERRQ(ierr);
4423       }
4424     }
4425     ierr = TSMonitor(ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
4426 
4427     if (ts->exact_final_time == TS_EXACTFINALTIME_INTERPOLATE && ts->ptime > ts->max_time) {
4428       ierr = TSInterpolate(ts,ts->max_time,u);CHKERRQ(ierr);
4429       ts->solvetime = ts->max_time;
4430       solution = u;
4431       ierr = TSMonitor(ts,-1,ts->solvetime,solution);CHKERRQ(ierr);
4432     } else {
4433       if (u) {ierr = VecCopy(ts->vec_sol,u);CHKERRQ(ierr);}
4434       ts->solvetime = ts->ptime;
4435       solution = ts->vec_sol;
4436     }
4437   }
4438 
4439   ierr = TSViewFromOptions(ts,NULL,"-ts_view");CHKERRQ(ierr);
4440   ierr = VecViewFromOptions(solution,NULL,"-ts_view_solution");CHKERRQ(ierr);
4441   ierr = PetscObjectSAWsBlock((PetscObject)ts);CHKERRQ(ierr);
4442   if (ts->adjoint_solve) {
4443     ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
4444   }
4445   PetscFunctionReturn(0);
4446 }
4447 
4448 /*@
4449  TSAdjointCostIntegral - Evaluate the cost integral in the adjoint run.
4450 
4451  Collective on TS
4452 
4453  Input Arguments:
4454  .  ts - time stepping context
4455 
4456  Level: advanced
4457 
4458  Notes:
4459  This function cannot be called until TSAdjointStep() has been completed.
4460 
4461  .seealso: TSAdjointSolve(), TSAdjointStep
4462  @*/
4463 PetscErrorCode TSAdjointCostIntegral(TS ts)
4464 {
4465     PetscErrorCode ierr;
4466     PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4467     if (!ts->ops->adjointintegral) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"%s does not provide integral evaluation in the adjoint run",((PetscObject)ts)->type_name);
4468     ierr = (*ts->ops->adjointintegral)(ts);CHKERRQ(ierr);
4469     PetscFunctionReturn(0);
4470 }
4471 
4472 /*@
4473    TSAdjointSolve - Solves the discrete ajoint problem for an ODE/DAE
4474 
4475    Collective on TS
4476 
4477    Input Parameter:
4478 .  ts - the TS context obtained from TSCreate()
4479 
4480    Options Database:
4481 . -ts_adjoint_view_solution <viewerinfo> - views the first gradient with respect to the initial values
4482 
4483    Level: intermediate
4484 
4485    Notes:
4486    This must be called after a call to TSSolve() that solves the forward problem
4487 
4488    By default this will integrate back to the initial time, one can use TSAdjointSetSteps() to step back to a later time
4489 
4490 .keywords: TS, timestep, solve
4491 
4492 .seealso: TSCreate(), TSSetCostGradients(), TSSetSolution(), TSAdjointStep()
4493 @*/
4494 PetscErrorCode TSAdjointSolve(TS ts)
4495 {
4496   PetscErrorCode    ierr;
4497 
4498   PetscFunctionBegin;
4499   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4500   ierr = TSAdjointSetUp(ts);CHKERRQ(ierr);
4501 
4502   /* reset time step and iteration counters */
4503   ts->adjoint_steps     = 0;
4504   ts->ksp_its           = 0;
4505   ts->snes_its          = 0;
4506   ts->num_snes_failures = 0;
4507   ts->reject            = 0;
4508   ts->reason            = TS_CONVERGED_ITERATING;
4509 
4510   if (!ts->adjoint_max_steps) ts->adjoint_max_steps = ts->steps;
4511   if (ts->adjoint_steps >= ts->adjoint_max_steps) ts->reason = TS_CONVERGED_ITS;
4512 
4513   while (!ts->reason) {
4514     ierr = TSTrajectoryGet(ts->trajectory,ts,ts->steps,&ts->ptime);CHKERRQ(ierr);
4515     ierr = TSAdjointMonitor(ts,ts->steps,ts->ptime,ts->vec_sol,ts->numcost,ts->vecs_sensi,ts->vecs_sensip);CHKERRQ(ierr);
4516     ierr = TSAdjointEventHandler(ts);CHKERRQ(ierr);
4517     ierr = TSAdjointStep(ts);CHKERRQ(ierr);
4518     if (ts->vec_costintegral && !ts->costintegralfwd) {
4519       ierr = TSAdjointCostIntegral(ts);CHKERRQ(ierr);
4520     }
4521   }
4522   ierr = TSTrajectoryGet(ts->trajectory,ts,ts->steps,&ts->ptime);CHKERRQ(ierr);
4523   ierr = TSAdjointMonitor(ts,ts->steps,ts->ptime,ts->vec_sol,ts->numcost,ts->vecs_sensi,ts->vecs_sensip);CHKERRQ(ierr);
4524   ts->solvetime = ts->ptime;
4525   ierr = TSTrajectoryViewFromOptions(ts->trajectory,NULL,"-ts_trajectory_view");CHKERRQ(ierr);
4526   ierr = VecViewFromOptions(ts->vecs_sensi[0],(PetscObject) ts, "-ts_adjoint_view_solution");CHKERRQ(ierr);
4527   ts->adjoint_max_steps = 0;
4528   PetscFunctionReturn(0);
4529 }
4530 
4531 /*@C
4532    TSMonitor - Runs all user-provided monitor routines set using TSMonitorSet()
4533 
4534    Collective on TS
4535 
4536    Input Parameters:
4537 +  ts - time stepping context obtained from TSCreate()
4538 .  step - step number that has just completed
4539 .  ptime - model time of the state
4540 -  u - state at the current model time
4541 
4542    Notes:
4543    TSMonitor() is typically used automatically within the time stepping implementations.
4544    Users would almost never call this routine directly.
4545 
4546    A step of -1 indicates that the monitor is being called on a solution obtained by interpolating from computed solutions
4547 
4548    Level: developer
4549 
4550 .keywords: TS, timestep
4551 @*/
4552 PetscErrorCode TSMonitor(TS ts,PetscInt step,PetscReal ptime,Vec u)
4553 {
4554   DM             dm;
4555   PetscInt       i,n = ts->numbermonitors;
4556   PetscErrorCode ierr;
4557 
4558   PetscFunctionBegin;
4559   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4560   PetscValidHeaderSpecific(u,VEC_CLASSID,4);
4561 
4562   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
4563   ierr = DMSetOutputSequenceNumber(dm,step,ptime);CHKERRQ(ierr);
4564 
4565   ierr = VecLockPush(u);CHKERRQ(ierr);
4566   for (i=0; i<n; i++) {
4567     ierr = (*ts->monitor[i])(ts,step,ptime,u,ts->monitorcontext[i]);CHKERRQ(ierr);
4568   }
4569   ierr = VecLockPop(u);CHKERRQ(ierr);
4570   PetscFunctionReturn(0);
4571 }
4572 
4573 /*@C
4574    TSAdjointMonitor - Runs all user-provided adjoint monitor routines set using TSAdjointMonitorSet()
4575 
4576    Collective on TS
4577 
4578    Input Parameters:
4579 +  ts - time stepping context obtained from TSCreate()
4580 .  step - step number that has just completed
4581 .  ptime - model time of the state
4582 .  u - state at the current model time
4583 .  numcost - number of cost functions (dimension of lambda  or mu)
4584 .  lambda - vectors containing the gradients of the cost functions with respect to the ODE/DAE solution variables
4585 -  mu - vectors containing the gradients of the cost functions with respect to the problem parameters
4586 
4587    Notes:
4588    TSAdjointMonitor() is typically used automatically within the time stepping implementations.
4589    Users would almost never call this routine directly.
4590 
4591    Level: developer
4592 
4593 .keywords: TS, timestep
4594 @*/
4595 PetscErrorCode TSAdjointMonitor(TS ts,PetscInt step,PetscReal ptime,Vec u,PetscInt numcost,Vec *lambda, Vec *mu)
4596 {
4597   PetscErrorCode ierr;
4598   PetscInt       i,n = ts->numberadjointmonitors;
4599 
4600   PetscFunctionBegin;
4601   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4602   PetscValidHeaderSpecific(u,VEC_CLASSID,4);
4603   ierr = VecLockPush(u);CHKERRQ(ierr);
4604   for (i=0; i<n; i++) {
4605     ierr = (*ts->adjointmonitor[i])(ts,step,ptime,u,numcost,lambda,mu,ts->adjointmonitorcontext[i]);CHKERRQ(ierr);
4606   }
4607   ierr = VecLockPop(u);CHKERRQ(ierr);
4608   PetscFunctionReturn(0);
4609 }
4610 
4611 /* ------------------------------------------------------------------------*/
4612 /*@C
4613    TSMonitorLGCtxCreate - Creates a TSMonitorLGCtx context for use with
4614    TS to monitor the solution process graphically in various ways
4615 
4616    Collective on TS
4617 
4618    Input Parameters:
4619 +  host - the X display to open, or null for the local machine
4620 .  label - the title to put in the title bar
4621 .  x, y - the screen coordinates of the upper left coordinate of the window
4622 .  m, n - the screen width and height in pixels
4623 -  howoften - if positive then determines the frequency of the plotting, if -1 then only at the final time
4624 
4625    Output Parameter:
4626 .  ctx - the context
4627 
4628    Options Database Key:
4629 +  -ts_monitor_lg_timestep - automatically sets line graph monitor
4630 +  -ts_monitor_lg_timestep_log - automatically sets line graph monitor
4631 .  -ts_monitor_lg_solution - monitor the solution (or certain values of the solution by calling TSMonitorLGSetDisplayVariables() or TSMonitorLGCtxSetDisplayVariables())
4632 .  -ts_monitor_lg_error -  monitor the error
4633 .  -ts_monitor_lg_ksp_iterations - monitor the number of KSP iterations needed for each timestep
4634 .  -ts_monitor_lg_snes_iterations - monitor the number of SNES iterations needed for each timestep
4635 -  -lg_use_markers <true,false> - mark the data points (at each time step) on the plot; default is true
4636 
4637    Notes:
4638    Use TSMonitorLGCtxDestroy() to destroy.
4639 
4640    One can provide a function that transforms the solution before plotting it with TSMonitorLGCtxSetTransform() or TSMonitorLGSetTransform()
4641 
4642    Many of the functions that control the monitoring have two forms: TSMonitorLGSet/GetXXXX() and TSMonitorLGCtxSet/GetXXXX() the first take a TS object as the
4643    first argument (if that TS object does not have a TSMonitorLGCtx associated with it the function call is ignored) and the second takes a TSMonitorLGCtx object
4644    as the first argument.
4645 
4646    One can control the names displayed for each solution or error variable with TSMonitorLGCtxSetVariableNames() or TSMonitorLGSetVariableNames()
4647 
4648    Level: intermediate
4649 
4650 .keywords: TS, monitor, line graph, residual
4651 
4652 .seealso: TSMonitorLGTimeStep(), TSMonitorSet(), TSMonitorLGSolution(), TSMonitorLGError(), TSMonitorDefault(), VecView(),
4653            TSMonitorLGCtxCreate(), TSMonitorLGCtxSetVariableNames(), TSMonitorLGCtxGetVariableNames(),
4654            TSMonitorLGSetVariableNames(), TSMonitorLGGetVariableNames(), TSMonitorLGSetDisplayVariables(), TSMonitorLGCtxSetDisplayVariables(),
4655            TSMonitorLGCtxSetTransform(), TSMonitorLGSetTransform(), TSMonitorLGError(), TSMonitorLGSNESIterations(), TSMonitorLGKSPIterations(),
4656            TSMonitorEnvelopeCtxCreate(), TSMonitorEnvelopeGetBounds(), TSMonitorEnvelopeCtxDestroy(), TSMonitorEnvelop()
4657 
4658 @*/
4659 PetscErrorCode  TSMonitorLGCtxCreate(MPI_Comm comm,const char host[],const char label[],int x,int y,int m,int n,PetscInt howoften,TSMonitorLGCtx *ctx)
4660 {
4661   PetscDraw      draw;
4662   PetscErrorCode ierr;
4663 
4664   PetscFunctionBegin;
4665   ierr = PetscNew(ctx);CHKERRQ(ierr);
4666   ierr = PetscDrawCreate(comm,host,label,x,y,m,n,&draw);CHKERRQ(ierr);
4667   ierr = PetscDrawSetFromOptions(draw);CHKERRQ(ierr);
4668   ierr = PetscDrawLGCreate(draw,1,&(*ctx)->lg);CHKERRQ(ierr);
4669   ierr = PetscDrawLGSetFromOptions((*ctx)->lg);CHKERRQ(ierr);
4670   ierr = PetscDrawDestroy(&draw);CHKERRQ(ierr);
4671   (*ctx)->howoften = howoften;
4672   PetscFunctionReturn(0);
4673 }
4674 
4675 PetscErrorCode TSMonitorLGTimeStep(TS ts,PetscInt step,PetscReal ptime,Vec v,void *monctx)
4676 {
4677   TSMonitorLGCtx ctx = (TSMonitorLGCtx) monctx;
4678   PetscReal      x   = ptime,y;
4679   PetscErrorCode ierr;
4680 
4681   PetscFunctionBegin;
4682   if (step < 0) PetscFunctionReturn(0); /* -1 indicates an interpolated solution */
4683   if (!step) {
4684     PetscDrawAxis axis;
4685     const char *ylabel = ctx->semilogy ? "Log Time Step" : "Time Step";
4686     ierr = PetscDrawLGGetAxis(ctx->lg,&axis);CHKERRQ(ierr);
4687     ierr = PetscDrawAxisSetLabels(axis,"Timestep as function of time","Time",ylabel);CHKERRQ(ierr);
4688     ierr = PetscDrawLGReset(ctx->lg);CHKERRQ(ierr);
4689   }
4690   ierr = TSGetTimeStep(ts,&y);CHKERRQ(ierr);
4691   if (ctx->semilogy) y = PetscLog10Real(y);
4692   ierr = PetscDrawLGAddPoint(ctx->lg,&x,&y);CHKERRQ(ierr);
4693   if (((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason)) {
4694     ierr = PetscDrawLGDraw(ctx->lg);CHKERRQ(ierr);
4695     ierr = PetscDrawLGSave(ctx->lg);CHKERRQ(ierr);
4696   }
4697   PetscFunctionReturn(0);
4698 }
4699 
4700 /*@C
4701    TSMonitorLGCtxDestroy - Destroys a line graph context that was created
4702    with TSMonitorLGCtxCreate().
4703 
4704    Collective on TSMonitorLGCtx
4705 
4706    Input Parameter:
4707 .  ctx - the monitor context
4708 
4709    Level: intermediate
4710 
4711 .keywords: TS, monitor, line graph, destroy
4712 
4713 .seealso: TSMonitorLGCtxCreate(),  TSMonitorSet(), TSMonitorLGTimeStep();
4714 @*/
4715 PetscErrorCode  TSMonitorLGCtxDestroy(TSMonitorLGCtx *ctx)
4716 {
4717   PetscErrorCode ierr;
4718 
4719   PetscFunctionBegin;
4720   if ((*ctx)->transformdestroy) {
4721     ierr = ((*ctx)->transformdestroy)((*ctx)->transformctx);CHKERRQ(ierr);
4722   }
4723   ierr = PetscDrawLGDestroy(&(*ctx)->lg);CHKERRQ(ierr);
4724   ierr = PetscStrArrayDestroy(&(*ctx)->names);CHKERRQ(ierr);
4725   ierr = PetscStrArrayDestroy(&(*ctx)->displaynames);CHKERRQ(ierr);
4726   ierr = PetscFree((*ctx)->displayvariables);CHKERRQ(ierr);
4727   ierr = PetscFree((*ctx)->displayvalues);CHKERRQ(ierr);
4728   ierr = PetscFree(*ctx);CHKERRQ(ierr);
4729   PetscFunctionReturn(0);
4730 }
4731 
4732 /*@
4733    TSGetTime - Gets the time of the most recently completed step.
4734 
4735    Not Collective
4736 
4737    Input Parameter:
4738 .  ts - the TS context obtained from TSCreate()
4739 
4740    Output Parameter:
4741 .  t  - the current time. This time may not corresponds to the final time set with TSSetMaxTime(), use TSGetSolveTime().
4742 
4743    Level: beginner
4744 
4745    Note:
4746    When called during time step evaluation (e.g. during residual evaluation or via hooks set using TSSetPreStep(),
4747    TSSetPreStage(), TSSetPostStage(), or TSSetPostStep()), the time is the time at the start of the step being evaluated.
4748 
4749 .seealso:  TSGetSolveTime(), TSSetTime(), TSGetTimeStep()
4750 
4751 .keywords: TS, get, time
4752 @*/
4753 PetscErrorCode  TSGetTime(TS ts,PetscReal *t)
4754 {
4755   PetscFunctionBegin;
4756   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4757   PetscValidRealPointer(t,2);
4758   *t = ts->ptime;
4759   PetscFunctionReturn(0);
4760 }
4761 
4762 /*@
4763    TSGetPrevTime - Gets the starting time of the previously completed step.
4764 
4765    Not Collective
4766 
4767    Input Parameter:
4768 .  ts - the TS context obtained from TSCreate()
4769 
4770    Output Parameter:
4771 .  t  - the previous time
4772 
4773    Level: beginner
4774 
4775 .seealso: TSGetTime(), TSGetSolveTime(), TSGetTimeStep()
4776 
4777 .keywords: TS, get, time
4778 @*/
4779 PetscErrorCode  TSGetPrevTime(TS ts,PetscReal *t)
4780 {
4781   PetscFunctionBegin;
4782   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4783   PetscValidRealPointer(t,2);
4784   *t = ts->ptime_prev;
4785   PetscFunctionReturn(0);
4786 }
4787 
4788 /*@
4789    TSSetTime - Allows one to reset the time.
4790 
4791    Logically Collective on TS
4792 
4793    Input Parameters:
4794 +  ts - the TS context obtained from TSCreate()
4795 -  time - the time
4796 
4797    Level: intermediate
4798 
4799 .seealso: TSGetTime(), TSSetMaxSteps()
4800 
4801 .keywords: TS, set, time
4802 @*/
4803 PetscErrorCode  TSSetTime(TS ts, PetscReal t)
4804 {
4805   PetscFunctionBegin;
4806   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4807   PetscValidLogicalCollectiveReal(ts,t,2);
4808   ts->ptime = t;
4809   PetscFunctionReturn(0);
4810 }
4811 
4812 /*@C
4813    TSSetOptionsPrefix - Sets the prefix used for searching for all
4814    TS options in the database.
4815 
4816    Logically Collective on TS
4817 
4818    Input Parameter:
4819 +  ts     - The TS context
4820 -  prefix - The prefix to prepend to all option names
4821 
4822    Notes:
4823    A hyphen (-) must NOT be given at the beginning of the prefix name.
4824    The first character of all runtime options is AUTOMATICALLY the
4825    hyphen.
4826 
4827    Level: advanced
4828 
4829 .keywords: TS, set, options, prefix, database
4830 
4831 .seealso: TSSetFromOptions()
4832 
4833 @*/
4834 PetscErrorCode  TSSetOptionsPrefix(TS ts,const char prefix[])
4835 {
4836   PetscErrorCode ierr;
4837   SNES           snes;
4838 
4839   PetscFunctionBegin;
4840   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4841   ierr = PetscObjectSetOptionsPrefix((PetscObject)ts,prefix);CHKERRQ(ierr);
4842   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
4843   ierr = SNESSetOptionsPrefix(snes,prefix);CHKERRQ(ierr);
4844   PetscFunctionReturn(0);
4845 }
4846 
4847 /*@C
4848    TSAppendOptionsPrefix - Appends to the prefix used for searching for all
4849    TS options in the database.
4850 
4851    Logically Collective on TS
4852 
4853    Input Parameter:
4854 +  ts     - The TS context
4855 -  prefix - The prefix to prepend to all option names
4856 
4857    Notes:
4858    A hyphen (-) must NOT be given at the beginning of the prefix name.
4859    The first character of all runtime options is AUTOMATICALLY the
4860    hyphen.
4861 
4862    Level: advanced
4863 
4864 .keywords: TS, append, options, prefix, database
4865 
4866 .seealso: TSGetOptionsPrefix()
4867 
4868 @*/
4869 PetscErrorCode  TSAppendOptionsPrefix(TS ts,const char prefix[])
4870 {
4871   PetscErrorCode ierr;
4872   SNES           snes;
4873 
4874   PetscFunctionBegin;
4875   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4876   ierr = PetscObjectAppendOptionsPrefix((PetscObject)ts,prefix);CHKERRQ(ierr);
4877   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
4878   ierr = SNESAppendOptionsPrefix(snes,prefix);CHKERRQ(ierr);
4879   PetscFunctionReturn(0);
4880 }
4881 
4882 /*@C
4883    TSGetOptionsPrefix - Sets the prefix used for searching for all
4884    TS options in the database.
4885 
4886    Not Collective
4887 
4888    Input Parameter:
4889 .  ts - The TS context
4890 
4891    Output Parameter:
4892 .  prefix - A pointer to the prefix string used
4893 
4894    Notes: On the fortran side, the user should pass in a string 'prifix' of
4895    sufficient length to hold the prefix.
4896 
4897    Level: intermediate
4898 
4899 .keywords: TS, get, options, prefix, database
4900 
4901 .seealso: TSAppendOptionsPrefix()
4902 @*/
4903 PetscErrorCode  TSGetOptionsPrefix(TS ts,const char *prefix[])
4904 {
4905   PetscErrorCode ierr;
4906 
4907   PetscFunctionBegin;
4908   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
4909   PetscValidPointer(prefix,2);
4910   ierr = PetscObjectGetOptionsPrefix((PetscObject)ts,prefix);CHKERRQ(ierr);
4911   PetscFunctionReturn(0);
4912 }
4913 
4914 /*@C
4915    TSGetRHSJacobian - Returns the Jacobian J at the present timestep.
4916 
4917    Not Collective, but parallel objects are returned if TS is parallel
4918 
4919    Input Parameter:
4920 .  ts  - The TS context obtained from TSCreate()
4921 
4922    Output Parameters:
4923 +  Amat - The (approximate) Jacobian J of G, where U_t = G(U,t)  (or NULL)
4924 .  Pmat - The matrix from which the preconditioner is constructed, usually the same as Amat  (or NULL)
4925 .  func - Function to compute the Jacobian of the RHS  (or NULL)
4926 -  ctx - User-defined context for Jacobian evaluation routine  (or NULL)
4927 
4928    Notes: You can pass in NULL for any return argument you do not need.
4929 
4930    Level: intermediate
4931 
4932 .seealso: TSGetTimeStep(), TSGetMatrices(), TSGetTime(), TSGetStepNumber()
4933 
4934 .keywords: TS, timestep, get, matrix, Jacobian
4935 @*/
4936 PetscErrorCode  TSGetRHSJacobian(TS ts,Mat *Amat,Mat *Pmat,TSRHSJacobian *func,void **ctx)
4937 {
4938   PetscErrorCode ierr;
4939   DM             dm;
4940 
4941   PetscFunctionBegin;
4942   if (Amat || Pmat) {
4943     SNES snes;
4944     ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
4945     ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
4946     ierr = SNESGetJacobian(snes,Amat,Pmat,NULL,NULL);CHKERRQ(ierr);
4947   }
4948   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
4949   ierr = DMTSGetRHSJacobian(dm,func,ctx);CHKERRQ(ierr);
4950   PetscFunctionReturn(0);
4951 }
4952 
4953 /*@C
4954    TSGetIJacobian - Returns the implicit Jacobian at the present timestep.
4955 
4956    Not Collective, but parallel objects are returned if TS is parallel
4957 
4958    Input Parameter:
4959 .  ts  - The TS context obtained from TSCreate()
4960 
4961    Output Parameters:
4962 +  Amat  - The (approximate) Jacobian of F(t,U,U_t)
4963 .  Pmat - The matrix from which the preconditioner is constructed, often the same as Amat
4964 .  f   - The function to compute the matrices
4965 - ctx - User-defined context for Jacobian evaluation routine
4966 
4967    Notes: You can pass in NULL for any return argument you do not need.
4968 
4969    Level: advanced
4970 
4971 .seealso: TSGetTimeStep(), TSGetRHSJacobian(), TSGetMatrices(), TSGetTime(), TSGetStepNumber()
4972 
4973 .keywords: TS, timestep, get, matrix, Jacobian
4974 @*/
4975 PetscErrorCode  TSGetIJacobian(TS ts,Mat *Amat,Mat *Pmat,TSIJacobian *f,void **ctx)
4976 {
4977   PetscErrorCode ierr;
4978   DM             dm;
4979 
4980   PetscFunctionBegin;
4981   if (Amat || Pmat) {
4982     SNES snes;
4983     ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
4984     ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
4985     ierr = SNESGetJacobian(snes,Amat,Pmat,NULL,NULL);CHKERRQ(ierr);
4986   }
4987   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
4988   ierr = DMTSGetIJacobian(dm,f,ctx);CHKERRQ(ierr);
4989   PetscFunctionReturn(0);
4990 }
4991 
4992 /*@C
4993    TSMonitorDrawSolution - Monitors progress of the TS solvers by calling
4994    VecView() for the solution at each timestep
4995 
4996    Collective on TS
4997 
4998    Input Parameters:
4999 +  ts - the TS context
5000 .  step - current time-step
5001 .  ptime - current time
5002 -  dummy - either a viewer or NULL
5003 
5004    Options Database:
5005 .   -ts_monitor_draw_solution_initial - show initial solution as well as current solution
5006 
5007    Notes: the initial solution and current solution are not display with a common axis scaling so generally the option -ts_monitor_draw_solution_initial
5008        will look bad
5009 
5010    Level: intermediate
5011 
5012 .keywords: TS,  vector, monitor, view
5013 
5014 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView()
5015 @*/
5016 PetscErrorCode  TSMonitorDrawSolution(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dummy)
5017 {
5018   PetscErrorCode   ierr;
5019   TSMonitorDrawCtx ictx = (TSMonitorDrawCtx)dummy;
5020   PetscDraw        draw;
5021 
5022   PetscFunctionBegin;
5023   if (!step && ictx->showinitial) {
5024     if (!ictx->initialsolution) {
5025       ierr = VecDuplicate(u,&ictx->initialsolution);CHKERRQ(ierr);
5026     }
5027     ierr = VecCopy(u,ictx->initialsolution);CHKERRQ(ierr);
5028   }
5029   if (!(((ictx->howoften > 0) && (!(step % ictx->howoften))) || ((ictx->howoften == -1) && ts->reason))) PetscFunctionReturn(0);
5030 
5031   if (ictx->showinitial) {
5032     PetscReal pause;
5033     ierr = PetscViewerDrawGetPause(ictx->viewer,&pause);CHKERRQ(ierr);
5034     ierr = PetscViewerDrawSetPause(ictx->viewer,0.0);CHKERRQ(ierr);
5035     ierr = VecView(ictx->initialsolution,ictx->viewer);CHKERRQ(ierr);
5036     ierr = PetscViewerDrawSetPause(ictx->viewer,pause);CHKERRQ(ierr);
5037     ierr = PetscViewerDrawSetHold(ictx->viewer,PETSC_TRUE);CHKERRQ(ierr);
5038   }
5039   ierr = VecView(u,ictx->viewer);CHKERRQ(ierr);
5040   if (ictx->showtimestepandtime) {
5041     PetscReal xl,yl,xr,yr,h;
5042     char      time[32];
5043 
5044     ierr = PetscViewerDrawGetDraw(ictx->viewer,0,&draw);CHKERRQ(ierr);
5045     ierr = PetscSNPrintf(time,32,"Timestep %d Time %g",(int)step,(double)ptime);CHKERRQ(ierr);
5046     ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
5047     h    = yl + .95*(yr - yl);
5048     ierr = PetscDrawStringCentered(draw,.5*(xl+xr),h,PETSC_DRAW_BLACK,time);CHKERRQ(ierr);
5049     ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
5050   }
5051 
5052   if (ictx->showinitial) {
5053     ierr = PetscViewerDrawSetHold(ictx->viewer,PETSC_FALSE);CHKERRQ(ierr);
5054   }
5055   PetscFunctionReturn(0);
5056 }
5057 
5058 /*@C
5059    TSAdjointMonitorDrawSensi - Monitors progress of the adjoint TS solvers by calling
5060    VecView() for the sensitivities to initial states at each timestep
5061 
5062    Collective on TS
5063 
5064    Input Parameters:
5065 +  ts - the TS context
5066 .  step - current time-step
5067 .  ptime - current time
5068 .  u - current state
5069 .  numcost - number of cost functions
5070 .  lambda - sensitivities to initial conditions
5071 .  mu - sensitivities to parameters
5072 -  dummy - either a viewer or NULL
5073 
5074    Level: intermediate
5075 
5076 .keywords: TS,  vector, adjoint, monitor, view
5077 
5078 .seealso: TSAdjointMonitorSet(), TSAdjointMonitorDefault(), VecView()
5079 @*/
5080 PetscErrorCode  TSAdjointMonitorDrawSensi(TS ts,PetscInt step,PetscReal ptime,Vec u,PetscInt numcost,Vec *lambda,Vec *mu,void *dummy)
5081 {
5082   PetscErrorCode   ierr;
5083   TSMonitorDrawCtx ictx = (TSMonitorDrawCtx)dummy;
5084   PetscDraw        draw;
5085   PetscReal        xl,yl,xr,yr,h;
5086   char             time[32];
5087 
5088   PetscFunctionBegin;
5089   if (!(((ictx->howoften > 0) && (!(step % ictx->howoften))) || ((ictx->howoften == -1) && ts->reason))) PetscFunctionReturn(0);
5090 
5091   ierr = VecView(lambda[0],ictx->viewer);CHKERRQ(ierr);
5092   ierr = PetscViewerDrawGetDraw(ictx->viewer,0,&draw);CHKERRQ(ierr);
5093   ierr = PetscSNPrintf(time,32,"Timestep %d Time %g",(int)step,(double)ptime);CHKERRQ(ierr);
5094   ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
5095   h    = yl + .95*(yr - yl);
5096   ierr = PetscDrawStringCentered(draw,.5*(xl+xr),h,PETSC_DRAW_BLACK,time);CHKERRQ(ierr);
5097   ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
5098   PetscFunctionReturn(0);
5099 }
5100 
5101 /*@C
5102    TSMonitorDrawSolutionPhase - Monitors progress of the TS solvers by plotting the solution as a phase diagram
5103 
5104    Collective on TS
5105 
5106    Input Parameters:
5107 +  ts - the TS context
5108 .  step - current time-step
5109 .  ptime - current time
5110 -  dummy - either a viewer or NULL
5111 
5112    Level: intermediate
5113 
5114 .keywords: TS,  vector, monitor, view
5115 
5116 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView()
5117 @*/
5118 PetscErrorCode  TSMonitorDrawSolutionPhase(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dummy)
5119 {
5120   PetscErrorCode    ierr;
5121   TSMonitorDrawCtx  ictx = (TSMonitorDrawCtx)dummy;
5122   PetscDraw         draw;
5123   PetscDrawAxis     axis;
5124   PetscInt          n;
5125   PetscMPIInt       size;
5126   PetscReal         U0,U1,xl,yl,xr,yr,h;
5127   char              time[32];
5128   const PetscScalar *U;
5129 
5130   PetscFunctionBegin;
5131   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)ts),&size);CHKERRQ(ierr);
5132   if (size != 1) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Only allowed for sequential runs");
5133   ierr = VecGetSize(u,&n);CHKERRQ(ierr);
5134   if (n != 2) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Only for ODEs with two unknowns");
5135 
5136   ierr = PetscViewerDrawGetDraw(ictx->viewer,0,&draw);CHKERRQ(ierr);
5137   ierr = PetscViewerDrawGetDrawAxis(ictx->viewer,0,&axis);CHKERRQ(ierr);
5138   ierr = PetscDrawAxisGetLimits(axis,&xl,&xr,&yl,&yr);CHKERRQ(ierr);
5139   if (!step) {
5140     ierr = PetscDrawClear(draw);CHKERRQ(ierr);
5141     ierr = PetscDrawAxisDraw(axis);CHKERRQ(ierr);
5142   }
5143 
5144   ierr = VecGetArrayRead(u,&U);CHKERRQ(ierr);
5145   U0 = PetscRealPart(U[0]);
5146   U1 = PetscRealPart(U[1]);
5147   ierr = VecRestoreArrayRead(u,&U);CHKERRQ(ierr);
5148   if ((U0 < xl) || (U1 < yl) || (U0 > xr) || (U1 > yr)) PetscFunctionReturn(0);
5149 
5150   ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
5151   ierr = PetscDrawPoint(draw,U0,U1,PETSC_DRAW_BLACK);CHKERRQ(ierr);
5152   if (ictx->showtimestepandtime) {
5153     ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr);
5154     ierr = PetscSNPrintf(time,32,"Timestep %d Time %g",(int)step,(double)ptime);CHKERRQ(ierr);
5155     h    = yl + .95*(yr - yl);
5156     ierr = PetscDrawStringCentered(draw,.5*(xl+xr),h,PETSC_DRAW_BLACK,time);CHKERRQ(ierr);
5157   }
5158   ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
5159   ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
5160   ierr = PetscDrawPause(draw);CHKERRQ(ierr);
5161   ierr = PetscDrawSave(draw);CHKERRQ(ierr);
5162   PetscFunctionReturn(0);
5163 }
5164 
5165 /*@C
5166    TSMonitorDrawCtxDestroy - Destroys the monitor context for TSMonitorDrawSolution()
5167 
5168    Collective on TS
5169 
5170    Input Parameters:
5171 .    ctx - the monitor context
5172 
5173    Level: intermediate
5174 
5175 .keywords: TS,  vector, monitor, view
5176 
5177 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorDrawSolution(), TSMonitorDrawError()
5178 @*/
5179 PetscErrorCode  TSMonitorDrawCtxDestroy(TSMonitorDrawCtx *ictx)
5180 {
5181   PetscErrorCode ierr;
5182 
5183   PetscFunctionBegin;
5184   ierr = PetscViewerDestroy(&(*ictx)->viewer);CHKERRQ(ierr);
5185   ierr = VecDestroy(&(*ictx)->initialsolution);CHKERRQ(ierr);
5186   ierr = PetscFree(*ictx);CHKERRQ(ierr);
5187   PetscFunctionReturn(0);
5188 }
5189 
5190 /*@C
5191    TSMonitorDrawCtxCreate - Creates the monitor context for TSMonitorDrawCtx
5192 
5193    Collective on TS
5194 
5195    Input Parameter:
5196 .    ts - time-step context
5197 
5198    Output Patameter:
5199 .    ctx - the monitor context
5200 
5201    Options Database:
5202 .   -ts_monitor_draw_solution_initial - show initial solution as well as current solution
5203 
5204    Level: intermediate
5205 
5206 .keywords: TS,  vector, monitor, view
5207 
5208 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorDrawCtx()
5209 @*/
5210 PetscErrorCode  TSMonitorDrawCtxCreate(MPI_Comm comm,const char host[],const char label[],int x,int y,int m,int n,PetscInt howoften,TSMonitorDrawCtx *ctx)
5211 {
5212   PetscErrorCode   ierr;
5213 
5214   PetscFunctionBegin;
5215   ierr = PetscNew(ctx);CHKERRQ(ierr);
5216   ierr = PetscViewerDrawOpen(comm,host,label,x,y,m,n,&(*ctx)->viewer);CHKERRQ(ierr);
5217   ierr = PetscViewerSetFromOptions((*ctx)->viewer);CHKERRQ(ierr);
5218 
5219   (*ctx)->howoften    = howoften;
5220   (*ctx)->showinitial = PETSC_FALSE;
5221   ierr = PetscOptionsGetBool(NULL,NULL,"-ts_monitor_draw_solution_initial",&(*ctx)->showinitial,NULL);CHKERRQ(ierr);
5222 
5223   (*ctx)->showtimestepandtime = PETSC_FALSE;
5224   ierr = PetscOptionsGetBool(NULL,NULL,"-ts_monitor_draw_solution_show_time",&(*ctx)->showtimestepandtime,NULL);CHKERRQ(ierr);
5225   PetscFunctionReturn(0);
5226 }
5227 
5228 /*@C
5229    TSMonitorDrawSolutionFunction - Monitors progress of the TS solvers by calling
5230    VecView() for the solution provided by TSSetSolutionFunction() at each timestep
5231 
5232    Collective on TS
5233 
5234    Input Parameters:
5235 +  ts - the TS context
5236 .  step - current time-step
5237 .  ptime - current time
5238 -  dummy - either a viewer or NULL
5239 
5240    Options Database:
5241 .  -ts_monitor_draw_solution_function - Monitor error graphically, requires user to have provided TSSetSolutionFunction()
5242 
5243    Level: intermediate
5244 
5245 .keywords: TS,  vector, monitor, view
5246 
5247 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSSetSolutionFunction()
5248 @*/
5249 PetscErrorCode  TSMonitorDrawSolutionFunction(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dummy)
5250 {
5251   PetscErrorCode   ierr;
5252   TSMonitorDrawCtx ctx    = (TSMonitorDrawCtx)dummy;
5253   PetscViewer      viewer = ctx->viewer;
5254   Vec              work;
5255 
5256   PetscFunctionBegin;
5257   if (!(((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason))) PetscFunctionReturn(0);
5258   ierr = VecDuplicate(u,&work);CHKERRQ(ierr);
5259   ierr = TSComputeSolutionFunction(ts,ptime,work);CHKERRQ(ierr);
5260   ierr = VecView(work,viewer);CHKERRQ(ierr);
5261   ierr = VecDestroy(&work);CHKERRQ(ierr);
5262   PetscFunctionReturn(0);
5263 }
5264 
5265 /*@C
5266    TSMonitorDrawError - Monitors progress of the TS solvers by calling
5267    VecView() for the error at each timestep
5268 
5269    Collective on TS
5270 
5271    Input Parameters:
5272 +  ts - the TS context
5273 .  step - current time-step
5274 .  ptime - current time
5275 -  dummy - either a viewer or NULL
5276 
5277    Options Database:
5278 .  -ts_monitor_draw_error - Monitor error graphically, requires user to have provided TSSetSolutionFunction()
5279 
5280    Level: intermediate
5281 
5282 .keywords: TS,  vector, monitor, view
5283 
5284 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSSetSolutionFunction()
5285 @*/
5286 PetscErrorCode  TSMonitorDrawError(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dummy)
5287 {
5288   PetscErrorCode   ierr;
5289   TSMonitorDrawCtx ctx    = (TSMonitorDrawCtx)dummy;
5290   PetscViewer      viewer = ctx->viewer;
5291   Vec              work;
5292 
5293   PetscFunctionBegin;
5294   if (!(((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason))) PetscFunctionReturn(0);
5295   ierr = VecDuplicate(u,&work);CHKERRQ(ierr);
5296   ierr = TSComputeSolutionFunction(ts,ptime,work);CHKERRQ(ierr);
5297   ierr = VecAXPY(work,-1.0,u);CHKERRQ(ierr);
5298   ierr = VecView(work,viewer);CHKERRQ(ierr);
5299   ierr = VecDestroy(&work);CHKERRQ(ierr);
5300   PetscFunctionReturn(0);
5301 }
5302 
5303 #include <petsc/private/dmimpl.h>
5304 /*@
5305    TSSetDM - Sets the DM that may be used by some nonlinear solvers or preconditioners under the TS
5306 
5307    Logically Collective on TS and DM
5308 
5309    Input Parameters:
5310 +  ts - the ODE integrator object
5311 -  dm - the dm, cannot be NULL
5312 
5313    Level: intermediate
5314 
5315 .seealso: TSGetDM(), SNESSetDM(), SNESGetDM()
5316 @*/
5317 PetscErrorCode  TSSetDM(TS ts,DM dm)
5318 {
5319   PetscErrorCode ierr;
5320   SNES           snes;
5321   DMTS           tsdm;
5322 
5323   PetscFunctionBegin;
5324   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5325   PetscValidHeaderSpecific(dm,DM_CLASSID,2);
5326   ierr = PetscObjectReference((PetscObject)dm);CHKERRQ(ierr);
5327   if (ts->dm) {               /* Move the DMTS context over to the new DM unless the new DM already has one */
5328     if (ts->dm->dmts && !dm->dmts) {
5329       ierr = DMCopyDMTS(ts->dm,dm);CHKERRQ(ierr);
5330       ierr = DMGetDMTS(ts->dm,&tsdm);CHKERRQ(ierr);
5331       if (tsdm->originaldm == ts->dm) { /* Grant write privileges to the replacement DM */
5332         tsdm->originaldm = dm;
5333       }
5334     }
5335     ierr = DMDestroy(&ts->dm);CHKERRQ(ierr);
5336   }
5337   ts->dm = dm;
5338 
5339   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
5340   ierr = SNESSetDM(snes,dm);CHKERRQ(ierr);
5341   PetscFunctionReturn(0);
5342 }
5343 
5344 /*@
5345    TSGetDM - Gets the DM that may be used by some preconditioners
5346 
5347    Not Collective
5348 
5349    Input Parameter:
5350 . ts - the preconditioner context
5351 
5352    Output Parameter:
5353 .  dm - the dm
5354 
5355    Level: intermediate
5356 
5357 .seealso: TSSetDM(), SNESSetDM(), SNESGetDM()
5358 @*/
5359 PetscErrorCode  TSGetDM(TS ts,DM *dm)
5360 {
5361   PetscErrorCode ierr;
5362 
5363   PetscFunctionBegin;
5364   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5365   if (!ts->dm) {
5366     ierr = DMShellCreate(PetscObjectComm((PetscObject)ts),&ts->dm);CHKERRQ(ierr);
5367     if (ts->snes) {ierr = SNESSetDM(ts->snes,ts->dm);CHKERRQ(ierr);}
5368   }
5369   *dm = ts->dm;
5370   PetscFunctionReturn(0);
5371 }
5372 
5373 /*@
5374    SNESTSFormFunction - Function to evaluate nonlinear residual
5375 
5376    Logically Collective on SNES
5377 
5378    Input Parameter:
5379 + snes - nonlinear solver
5380 . U - the current state at which to evaluate the residual
5381 - ctx - user context, must be a TS
5382 
5383    Output Parameter:
5384 . F - the nonlinear residual
5385 
5386    Notes:
5387    This function is not normally called by users and is automatically registered with the SNES used by TS.
5388    It is most frequently passed to MatFDColoringSetFunction().
5389 
5390    Level: advanced
5391 
5392 .seealso: SNESSetFunction(), MatFDColoringSetFunction()
5393 @*/
5394 PetscErrorCode  SNESTSFormFunction(SNES snes,Vec U,Vec F,void *ctx)
5395 {
5396   TS             ts = (TS)ctx;
5397   PetscErrorCode ierr;
5398 
5399   PetscFunctionBegin;
5400   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
5401   PetscValidHeaderSpecific(U,VEC_CLASSID,2);
5402   PetscValidHeaderSpecific(F,VEC_CLASSID,3);
5403   PetscValidHeaderSpecific(ts,TS_CLASSID,4);
5404   ierr = (ts->ops->snesfunction)(snes,U,F,ts);CHKERRQ(ierr);
5405   PetscFunctionReturn(0);
5406 }
5407 
5408 /*@
5409    SNESTSFormJacobian - Function to evaluate the Jacobian
5410 
5411    Collective on SNES
5412 
5413    Input Parameter:
5414 + snes - nonlinear solver
5415 . U - the current state at which to evaluate the residual
5416 - ctx - user context, must be a TS
5417 
5418    Output Parameter:
5419 + A - the Jacobian
5420 . B - the preconditioning matrix (may be the same as A)
5421 - flag - indicates any structure change in the matrix
5422 
5423    Notes:
5424    This function is not normally called by users and is automatically registered with the SNES used by TS.
5425 
5426    Level: developer
5427 
5428 .seealso: SNESSetJacobian()
5429 @*/
5430 PetscErrorCode  SNESTSFormJacobian(SNES snes,Vec U,Mat A,Mat B,void *ctx)
5431 {
5432   TS             ts = (TS)ctx;
5433   PetscErrorCode ierr;
5434 
5435   PetscFunctionBegin;
5436   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
5437   PetscValidHeaderSpecific(U,VEC_CLASSID,2);
5438   PetscValidPointer(A,3);
5439   PetscValidHeaderSpecific(A,MAT_CLASSID,3);
5440   PetscValidPointer(B,4);
5441   PetscValidHeaderSpecific(B,MAT_CLASSID,4);
5442   PetscValidHeaderSpecific(ts,TS_CLASSID,6);
5443   ierr = (ts->ops->snesjacobian)(snes,U,A,B,ts);CHKERRQ(ierr);
5444   PetscFunctionReturn(0);
5445 }
5446 
5447 /*@C
5448    TSComputeRHSFunctionLinear - Evaluate the right hand side via the user-provided Jacobian, for linear problems Udot = A U only
5449 
5450    Collective on TS
5451 
5452    Input Arguments:
5453 +  ts - time stepping context
5454 .  t - time at which to evaluate
5455 .  U - state at which to evaluate
5456 -  ctx - context
5457 
5458    Output Arguments:
5459 .  F - right hand side
5460 
5461    Level: intermediate
5462 
5463    Notes:
5464    This function is intended to be passed to TSSetRHSFunction() to evaluate the right hand side for linear problems.
5465    The matrix (and optionally the evaluation context) should be passed to TSSetRHSJacobian().
5466 
5467 .seealso: TSSetRHSFunction(), TSSetRHSJacobian(), TSComputeRHSJacobianConstant()
5468 @*/
5469 PetscErrorCode TSComputeRHSFunctionLinear(TS ts,PetscReal t,Vec U,Vec F,void *ctx)
5470 {
5471   PetscErrorCode ierr;
5472   Mat            Arhs,Brhs;
5473 
5474   PetscFunctionBegin;
5475   ierr = TSGetRHSMats_Private(ts,&Arhs,&Brhs);CHKERRQ(ierr);
5476   ierr = TSComputeRHSJacobian(ts,t,U,Arhs,Brhs);CHKERRQ(ierr);
5477   ierr = MatMult(Arhs,U,F);CHKERRQ(ierr);
5478   PetscFunctionReturn(0);
5479 }
5480 
5481 /*@C
5482    TSComputeRHSJacobianConstant - Reuses a Jacobian that is time-independent.
5483 
5484    Collective on TS
5485 
5486    Input Arguments:
5487 +  ts - time stepping context
5488 .  t - time at which to evaluate
5489 .  U - state at which to evaluate
5490 -  ctx - context
5491 
5492    Output Arguments:
5493 +  A - pointer to operator
5494 .  B - pointer to preconditioning matrix
5495 -  flg - matrix structure flag
5496 
5497    Level: intermediate
5498 
5499    Notes:
5500    This function is intended to be passed to TSSetRHSJacobian() to evaluate the Jacobian for linear time-independent problems.
5501 
5502 .seealso: TSSetRHSFunction(), TSSetRHSJacobian(), TSComputeRHSFunctionLinear()
5503 @*/
5504 PetscErrorCode TSComputeRHSJacobianConstant(TS ts,PetscReal t,Vec U,Mat A,Mat B,void *ctx)
5505 {
5506   PetscFunctionBegin;
5507   PetscFunctionReturn(0);
5508 }
5509 
5510 /*@C
5511    TSComputeIFunctionLinear - Evaluate the left hand side via the user-provided Jacobian, for linear problems only
5512 
5513    Collective on TS
5514 
5515    Input Arguments:
5516 +  ts - time stepping context
5517 .  t - time at which to evaluate
5518 .  U - state at which to evaluate
5519 .  Udot - time derivative of state vector
5520 -  ctx - context
5521 
5522    Output Arguments:
5523 .  F - left hand side
5524 
5525    Level: intermediate
5526 
5527    Notes:
5528    The assumption here is that the left hand side is of the form A*Udot (and not A*Udot + B*U). For other cases, the
5529    user is required to write their own TSComputeIFunction.
5530    This function is intended to be passed to TSSetIFunction() to evaluate the left hand side for linear problems.
5531    The matrix (and optionally the evaluation context) should be passed to TSSetIJacobian().
5532 
5533    Note that using this function is NOT equivalent to using TSComputeRHSFunctionLinear() since that solves Udot = A U
5534 
5535 .seealso: TSSetIFunction(), TSSetIJacobian(), TSComputeIJacobianConstant(), TSComputeRHSFunctionLinear()
5536 @*/
5537 PetscErrorCode TSComputeIFunctionLinear(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void *ctx)
5538 {
5539   PetscErrorCode ierr;
5540   Mat            A,B;
5541 
5542   PetscFunctionBegin;
5543   ierr = TSGetIJacobian(ts,&A,&B,NULL,NULL);CHKERRQ(ierr);
5544   ierr = TSComputeIJacobian(ts,t,U,Udot,1.0,A,B,PETSC_TRUE);CHKERRQ(ierr);
5545   ierr = MatMult(A,Udot,F);CHKERRQ(ierr);
5546   PetscFunctionReturn(0);
5547 }
5548 
5549 /*@C
5550    TSComputeIJacobianConstant - Reuses a time-independent for a semi-implicit DAE or ODE
5551 
5552    Collective on TS
5553 
5554    Input Arguments:
5555 +  ts - time stepping context
5556 .  t - time at which to evaluate
5557 .  U - state at which to evaluate
5558 .  Udot - time derivative of state vector
5559 .  shift - shift to apply
5560 -  ctx - context
5561 
5562    Output Arguments:
5563 +  A - pointer to operator
5564 .  B - pointer to preconditioning matrix
5565 -  flg - matrix structure flag
5566 
5567    Level: advanced
5568 
5569    Notes:
5570    This function is intended to be passed to TSSetIJacobian() to evaluate the Jacobian for linear time-independent problems.
5571 
5572    It is only appropriate for problems of the form
5573 
5574 $     M Udot = F(U,t)
5575 
5576   where M is constant and F is non-stiff.  The user must pass M to TSSetIJacobian().  The current implementation only
5577   works with IMEX time integration methods such as TSROSW and TSARKIMEX, since there is no support for de-constructing
5578   an implicit operator of the form
5579 
5580 $    shift*M + J
5581 
5582   where J is the Jacobian of -F(U).  Support may be added in a future version of PETSc, but for now, the user must store
5583   a copy of M or reassemble it when requested.
5584 
5585 .seealso: TSSetIFunction(), TSSetIJacobian(), TSComputeIFunctionLinear()
5586 @*/
5587 PetscErrorCode TSComputeIJacobianConstant(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal shift,Mat A,Mat B,void *ctx)
5588 {
5589   PetscErrorCode ierr;
5590 
5591   PetscFunctionBegin;
5592   ierr = MatScale(A, shift / ts->ijacobian.shift);CHKERRQ(ierr);
5593   ts->ijacobian.shift = shift;
5594   PetscFunctionReturn(0);
5595 }
5596 
5597 /*@
5598    TSGetEquationType - Gets the type of the equation that TS is solving.
5599 
5600    Not Collective
5601 
5602    Input Parameter:
5603 .  ts - the TS context
5604 
5605    Output Parameter:
5606 .  equation_type - see TSEquationType
5607 
5608    Level: beginner
5609 
5610 .keywords: TS, equation type
5611 
5612 .seealso: TSSetEquationType(), TSEquationType
5613 @*/
5614 PetscErrorCode  TSGetEquationType(TS ts,TSEquationType *equation_type)
5615 {
5616   PetscFunctionBegin;
5617   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5618   PetscValidPointer(equation_type,2);
5619   *equation_type = ts->equation_type;
5620   PetscFunctionReturn(0);
5621 }
5622 
5623 /*@
5624    TSSetEquationType - Sets the type of the equation that TS is solving.
5625 
5626    Not Collective
5627 
5628    Input Parameter:
5629 +  ts - the TS context
5630 -  equation_type - see TSEquationType
5631 
5632    Level: advanced
5633 
5634 .keywords: TS, equation type
5635 
5636 .seealso: TSGetEquationType(), TSEquationType
5637 @*/
5638 PetscErrorCode  TSSetEquationType(TS ts,TSEquationType equation_type)
5639 {
5640   PetscFunctionBegin;
5641   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5642   ts->equation_type = equation_type;
5643   PetscFunctionReturn(0);
5644 }
5645 
5646 /*@
5647    TSGetConvergedReason - Gets the reason the TS iteration was stopped.
5648 
5649    Not Collective
5650 
5651    Input Parameter:
5652 .  ts - the TS context
5653 
5654    Output Parameter:
5655 .  reason - negative value indicates diverged, positive value converged, see TSConvergedReason or the
5656             manual pages for the individual convergence tests for complete lists
5657 
5658    Level: beginner
5659 
5660    Notes:
5661    Can only be called after the call to TSSolve() is complete.
5662 
5663 .keywords: TS, nonlinear, set, convergence, test
5664 
5665 .seealso: TSSetConvergenceTest(), TSConvergedReason
5666 @*/
5667 PetscErrorCode  TSGetConvergedReason(TS ts,TSConvergedReason *reason)
5668 {
5669   PetscFunctionBegin;
5670   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5671   PetscValidPointer(reason,2);
5672   *reason = ts->reason;
5673   PetscFunctionReturn(0);
5674 }
5675 
5676 /*@
5677    TSSetConvergedReason - Sets the reason for handling the convergence of TSSolve.
5678 
5679    Not Collective
5680 
5681    Input Parameter:
5682 +  ts - the TS context
5683 .  reason - negative value indicates diverged, positive value converged, see TSConvergedReason or the
5684             manual pages for the individual convergence tests for complete lists
5685 
5686    Level: advanced
5687 
5688    Notes:
5689    Can only be called during TSSolve() is active.
5690 
5691 .keywords: TS, nonlinear, set, convergence, test
5692 
5693 .seealso: TSConvergedReason
5694 @*/
5695 PetscErrorCode  TSSetConvergedReason(TS ts,TSConvergedReason reason)
5696 {
5697   PetscFunctionBegin;
5698   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5699   ts->reason = reason;
5700   PetscFunctionReturn(0);
5701 }
5702 
5703 /*@
5704    TSGetSolveTime - Gets the time after a call to TSSolve()
5705 
5706    Not Collective
5707 
5708    Input Parameter:
5709 .  ts - the TS context
5710 
5711    Output Parameter:
5712 .  ftime - the final time. This time corresponds to the final time set with TSSetMaxTime()
5713 
5714    Level: beginner
5715 
5716    Notes:
5717    Can only be called after the call to TSSolve() is complete.
5718 
5719 .keywords: TS, nonlinear, set, convergence, test
5720 
5721 .seealso: TSSetConvergenceTest(), TSConvergedReason
5722 @*/
5723 PetscErrorCode  TSGetSolveTime(TS ts,PetscReal *ftime)
5724 {
5725   PetscFunctionBegin;
5726   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5727   PetscValidPointer(ftime,2);
5728   *ftime = ts->solvetime;
5729   PetscFunctionReturn(0);
5730 }
5731 
5732 /*@
5733    TSGetSNESIterations - Gets the total number of nonlinear iterations
5734    used by the time integrator.
5735 
5736    Not Collective
5737 
5738    Input Parameter:
5739 .  ts - TS context
5740 
5741    Output Parameter:
5742 .  nits - number of nonlinear iterations
5743 
5744    Notes:
5745    This counter is reset to zero for each successive call to TSSolve().
5746 
5747    Level: intermediate
5748 
5749 .keywords: TS, get, number, nonlinear, iterations
5750 
5751 .seealso:  TSGetKSPIterations()
5752 @*/
5753 PetscErrorCode TSGetSNESIterations(TS ts,PetscInt *nits)
5754 {
5755   PetscFunctionBegin;
5756   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5757   PetscValidIntPointer(nits,2);
5758   *nits = ts->snes_its;
5759   PetscFunctionReturn(0);
5760 }
5761 
5762 /*@
5763    TSGetKSPIterations - Gets the total number of linear iterations
5764    used by the time integrator.
5765 
5766    Not Collective
5767 
5768    Input Parameter:
5769 .  ts - TS context
5770 
5771    Output Parameter:
5772 .  lits - number of linear iterations
5773 
5774    Notes:
5775    This counter is reset to zero for each successive call to TSSolve().
5776 
5777    Level: intermediate
5778 
5779 .keywords: TS, get, number, linear, iterations
5780 
5781 .seealso:  TSGetSNESIterations(), SNESGetKSPIterations()
5782 @*/
5783 PetscErrorCode TSGetKSPIterations(TS ts,PetscInt *lits)
5784 {
5785   PetscFunctionBegin;
5786   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5787   PetscValidIntPointer(lits,2);
5788   *lits = ts->ksp_its;
5789   PetscFunctionReturn(0);
5790 }
5791 
5792 /*@
5793    TSGetStepRejections - Gets the total number of rejected steps.
5794 
5795    Not Collective
5796 
5797    Input Parameter:
5798 .  ts - TS context
5799 
5800    Output Parameter:
5801 .  rejects - number of steps rejected
5802 
5803    Notes:
5804    This counter is reset to zero for each successive call to TSSolve().
5805 
5806    Level: intermediate
5807 
5808 .keywords: TS, get, number
5809 
5810 .seealso:  TSGetSNESIterations(), TSGetKSPIterations(), TSSetMaxStepRejections(), TSGetSNESFailures(), TSSetMaxSNESFailures(), TSSetErrorIfStepFails()
5811 @*/
5812 PetscErrorCode TSGetStepRejections(TS ts,PetscInt *rejects)
5813 {
5814   PetscFunctionBegin;
5815   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5816   PetscValidIntPointer(rejects,2);
5817   *rejects = ts->reject;
5818   PetscFunctionReturn(0);
5819 }
5820 
5821 /*@
5822    TSGetSNESFailures - Gets the total number of failed SNES solves
5823 
5824    Not Collective
5825 
5826    Input Parameter:
5827 .  ts - TS context
5828 
5829    Output Parameter:
5830 .  fails - number of failed nonlinear solves
5831 
5832    Notes:
5833    This counter is reset to zero for each successive call to TSSolve().
5834 
5835    Level: intermediate
5836 
5837 .keywords: TS, get, number
5838 
5839 .seealso:  TSGetSNESIterations(), TSGetKSPIterations(), TSSetMaxStepRejections(), TSGetStepRejections(), TSSetMaxSNESFailures()
5840 @*/
5841 PetscErrorCode TSGetSNESFailures(TS ts,PetscInt *fails)
5842 {
5843   PetscFunctionBegin;
5844   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5845   PetscValidIntPointer(fails,2);
5846   *fails = ts->num_snes_failures;
5847   PetscFunctionReturn(0);
5848 }
5849 
5850 /*@
5851    TSSetMaxStepRejections - Sets the maximum number of step rejections before a step fails
5852 
5853    Not Collective
5854 
5855    Input Parameter:
5856 +  ts - TS context
5857 -  rejects - maximum number of rejected steps, pass -1 for unlimited
5858 
5859    Notes:
5860    The counter is reset to zero for each step
5861 
5862    Options Database Key:
5863  .  -ts_max_reject - Maximum number of step rejections before a step fails
5864 
5865    Level: intermediate
5866 
5867 .keywords: TS, set, maximum, number
5868 
5869 .seealso:  TSGetSNESIterations(), TSGetKSPIterations(), TSSetMaxSNESFailures(), TSGetStepRejections(), TSGetSNESFailures(), TSSetErrorIfStepFails(), TSGetConvergedReason()
5870 @*/
5871 PetscErrorCode TSSetMaxStepRejections(TS ts,PetscInt rejects)
5872 {
5873   PetscFunctionBegin;
5874   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5875   ts->max_reject = rejects;
5876   PetscFunctionReturn(0);
5877 }
5878 
5879 /*@
5880    TSSetMaxSNESFailures - Sets the maximum number of failed SNES solves
5881 
5882    Not Collective
5883 
5884    Input Parameter:
5885 +  ts - TS context
5886 -  fails - maximum number of failed nonlinear solves, pass -1 for unlimited
5887 
5888    Notes:
5889    The counter is reset to zero for each successive call to TSSolve().
5890 
5891    Options Database Key:
5892  .  -ts_max_snes_failures - Maximum number of nonlinear solve failures
5893 
5894    Level: intermediate
5895 
5896 .keywords: TS, set, maximum, number
5897 
5898 .seealso:  TSGetSNESIterations(), TSGetKSPIterations(), TSSetMaxStepRejections(), TSGetStepRejections(), TSGetSNESFailures(), SNESGetConvergedReason(), TSGetConvergedReason()
5899 @*/
5900 PetscErrorCode TSSetMaxSNESFailures(TS ts,PetscInt fails)
5901 {
5902   PetscFunctionBegin;
5903   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5904   ts->max_snes_failures = fails;
5905   PetscFunctionReturn(0);
5906 }
5907 
5908 /*@
5909    TSSetErrorIfStepFails - Error if no step succeeds
5910 
5911    Not Collective
5912 
5913    Input Parameter:
5914 +  ts - TS context
5915 -  err - PETSC_TRUE to error if no step succeeds, PETSC_FALSE to return without failure
5916 
5917    Options Database Key:
5918  .  -ts_error_if_step_fails - Error if no step succeeds
5919 
5920    Level: intermediate
5921 
5922 .keywords: TS, set, error
5923 
5924 .seealso:  TSGetSNESIterations(), TSGetKSPIterations(), TSSetMaxStepRejections(), TSGetStepRejections(), TSGetSNESFailures(), TSSetErrorIfStepFails(), TSGetConvergedReason()
5925 @*/
5926 PetscErrorCode TSSetErrorIfStepFails(TS ts,PetscBool err)
5927 {
5928   PetscFunctionBegin;
5929   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
5930   ts->errorifstepfailed = err;
5931   PetscFunctionReturn(0);
5932 }
5933 
5934 /*@C
5935    TSMonitorSolution - Monitors progress of the TS solvers by VecView() for the solution at each timestep. Normally the viewer is a binary file or a PetscDraw object
5936 
5937    Collective on TS
5938 
5939    Input Parameters:
5940 +  ts - the TS context
5941 .  step - current time-step
5942 .  ptime - current time
5943 .  u - current state
5944 -  vf - viewer and its format
5945 
5946    Level: intermediate
5947 
5948 .keywords: TS,  vector, monitor, view
5949 
5950 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView()
5951 @*/
5952 PetscErrorCode  TSMonitorSolution(TS ts,PetscInt step,PetscReal ptime,Vec u,PetscViewerAndFormat *vf)
5953 {
5954   PetscErrorCode ierr;
5955 
5956   PetscFunctionBegin;
5957   ierr = PetscViewerPushFormat(vf->viewer,vf->format);CHKERRQ(ierr);
5958   ierr = VecView(u,vf->viewer);CHKERRQ(ierr);
5959   ierr = PetscViewerPopFormat(vf->viewer);CHKERRQ(ierr);
5960   PetscFunctionReturn(0);
5961 }
5962 
5963 /*@C
5964    TSMonitorSolutionVTK - Monitors progress of the TS solvers by VecView() for the solution at each timestep.
5965 
5966    Collective on TS
5967 
5968    Input Parameters:
5969 +  ts - the TS context
5970 .  step - current time-step
5971 .  ptime - current time
5972 .  u - current state
5973 -  filenametemplate - string containing a format specifier for the integer time step (e.g. %03D)
5974 
5975    Level: intermediate
5976 
5977    Notes:
5978    The VTK format does not allow writing multiple time steps in the same file, therefore a different file will be written for each time step.
5979    These are named according to the file name template.
5980 
5981    This function is normally passed as an argument to TSMonitorSet() along with TSMonitorSolutionVTKDestroy().
5982 
5983 .keywords: TS,  vector, monitor, view
5984 
5985 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView()
5986 @*/
5987 PetscErrorCode TSMonitorSolutionVTK(TS ts,PetscInt step,PetscReal ptime,Vec u,void *filenametemplate)
5988 {
5989   PetscErrorCode ierr;
5990   char           filename[PETSC_MAX_PATH_LEN];
5991   PetscViewer    viewer;
5992 
5993   PetscFunctionBegin;
5994   if (step < 0) PetscFunctionReturn(0); /* -1 indicates interpolated solution */
5995   ierr = PetscSNPrintf(filename,sizeof(filename),(const char*)filenametemplate,step);CHKERRQ(ierr);
5996   ierr = PetscViewerVTKOpen(PetscObjectComm((PetscObject)ts),filename,FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
5997   ierr = VecView(u,viewer);CHKERRQ(ierr);
5998   ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
5999   PetscFunctionReturn(0);
6000 }
6001 
6002 /*@C
6003    TSMonitorSolutionVTKDestroy - Destroy context for monitoring
6004 
6005    Collective on TS
6006 
6007    Input Parameters:
6008 .  filenametemplate - string containing a format specifier for the integer time step (e.g. %03D)
6009 
6010    Level: intermediate
6011 
6012    Note:
6013    This function is normally passed to TSMonitorSet() along with TSMonitorSolutionVTK().
6014 
6015 .keywords: TS,  vector, monitor, view
6016 
6017 .seealso: TSMonitorSet(), TSMonitorSolutionVTK()
6018 @*/
6019 PetscErrorCode TSMonitorSolutionVTKDestroy(void *filenametemplate)
6020 {
6021   PetscErrorCode ierr;
6022 
6023   PetscFunctionBegin;
6024   ierr = PetscFree(*(char**)filenametemplate);CHKERRQ(ierr);
6025   PetscFunctionReturn(0);
6026 }
6027 
6028 /*@
6029    TSGetAdapt - Get the adaptive controller context for the current method
6030 
6031    Collective on TS if controller has not been created yet
6032 
6033    Input Arguments:
6034 .  ts - time stepping context
6035 
6036    Output Arguments:
6037 .  adapt - adaptive controller
6038 
6039    Level: intermediate
6040 
6041 .seealso: TSAdapt, TSAdaptSetType(), TSAdaptChoose()
6042 @*/
6043 PetscErrorCode TSGetAdapt(TS ts,TSAdapt *adapt)
6044 {
6045   PetscErrorCode ierr;
6046 
6047   PetscFunctionBegin;
6048   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6049   PetscValidPointer(adapt,2);
6050   if (!ts->adapt) {
6051     ierr = TSAdaptCreate(PetscObjectComm((PetscObject)ts),&ts->adapt);CHKERRQ(ierr);
6052     ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)ts->adapt);CHKERRQ(ierr);
6053     ierr = PetscObjectIncrementTabLevel((PetscObject)ts->adapt,(PetscObject)ts,1);CHKERRQ(ierr);
6054   }
6055   *adapt = ts->adapt;
6056   PetscFunctionReturn(0);
6057 }
6058 
6059 /*@
6060    TSSetTolerances - Set tolerances for local truncation error when using adaptive controller
6061 
6062    Logically Collective
6063 
6064    Input Arguments:
6065 +  ts - time integration context
6066 .  atol - scalar absolute tolerances, PETSC_DECIDE to leave current value
6067 .  vatol - vector of absolute tolerances or NULL, used in preference to atol if present
6068 .  rtol - scalar relative tolerances, PETSC_DECIDE to leave current value
6069 -  vrtol - vector of relative tolerances or NULL, used in preference to atol if present
6070 
6071    Options Database keys:
6072 +  -ts_rtol <rtol> - relative tolerance for local truncation error
6073 -  -ts_atol <atol> Absolute tolerance for local truncation error
6074 
6075    Notes:
6076    With PETSc's implicit schemes for DAE problems, the calculation of the local truncation error
6077    (LTE) includes both the differential and the algebraic variables. If one wants the LTE to be
6078    computed only for the differential or the algebraic part then this can be done using the vector of
6079    tolerances vatol. For example, by setting the tolerance vector with the desired tolerance for the
6080    differential part and infinity for the algebraic part, the LTE calculation will include only the
6081    differential variables.
6082 
6083    Level: beginner
6084 
6085 .seealso: TS, TSAdapt, TSVecNormWRMS(), TSGetTolerances()
6086 @*/
6087 PetscErrorCode TSSetTolerances(TS ts,PetscReal atol,Vec vatol,PetscReal rtol,Vec vrtol)
6088 {
6089   PetscErrorCode ierr;
6090 
6091   PetscFunctionBegin;
6092   if (atol != PETSC_DECIDE && atol != PETSC_DEFAULT) ts->atol = atol;
6093   if (vatol) {
6094     ierr = PetscObjectReference((PetscObject)vatol);CHKERRQ(ierr);
6095     ierr = VecDestroy(&ts->vatol);CHKERRQ(ierr);
6096     ts->vatol = vatol;
6097   }
6098   if (rtol != PETSC_DECIDE && rtol != PETSC_DEFAULT) ts->rtol = rtol;
6099   if (vrtol) {
6100     ierr = PetscObjectReference((PetscObject)vrtol);CHKERRQ(ierr);
6101     ierr = VecDestroy(&ts->vrtol);CHKERRQ(ierr);
6102     ts->vrtol = vrtol;
6103   }
6104   PetscFunctionReturn(0);
6105 }
6106 
6107 /*@
6108    TSGetTolerances - Get tolerances for local truncation error when using adaptive controller
6109 
6110    Logically Collective
6111 
6112    Input Arguments:
6113 .  ts - time integration context
6114 
6115    Output Arguments:
6116 +  atol - scalar absolute tolerances, NULL to ignore
6117 .  vatol - vector of absolute tolerances, NULL to ignore
6118 .  rtol - scalar relative tolerances, NULL to ignore
6119 -  vrtol - vector of relative tolerances, NULL to ignore
6120 
6121    Level: beginner
6122 
6123 .seealso: TS, TSAdapt, TSVecNormWRMS(), TSSetTolerances()
6124 @*/
6125 PetscErrorCode TSGetTolerances(TS ts,PetscReal *atol,Vec *vatol,PetscReal *rtol,Vec *vrtol)
6126 {
6127   PetscFunctionBegin;
6128   if (atol)  *atol  = ts->atol;
6129   if (vatol) *vatol = ts->vatol;
6130   if (rtol)  *rtol  = ts->rtol;
6131   if (vrtol) *vrtol = ts->vrtol;
6132   PetscFunctionReturn(0);
6133 }
6134 
6135 /*@
6136    TSErrorWeightedNorm2 - compute a weighted 2-norm of the difference between two state vectors
6137 
6138    Collective on TS
6139 
6140    Input Arguments:
6141 +  ts - time stepping context
6142 .  U - state vector, usually ts->vec_sol
6143 -  Y - state vector to be compared to U
6144 
6145    Output Arguments:
6146 .  norm - weighted norm, a value of 1.0 means that the error matches the tolerances
6147 .  norma - weighted norm based on the absolute tolerance, a value of 1.0 means that the error matches the tolerances
6148 .  normr - weighted norm based on the relative tolerance, a value of 1.0 means that the error matches the tolerances
6149 
6150    Level: developer
6151 
6152 .seealso: TSErrorWeightedNorm(), TSErrorWeightedNormInfinity()
6153 @*/
6154 PetscErrorCode TSErrorWeightedNorm2(TS ts,Vec U,Vec Y,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6155 {
6156   PetscErrorCode    ierr;
6157   PetscInt          i,n,N,rstart;
6158   PetscInt          n_loc,na_loc,nr_loc;
6159   PetscReal         n_glb,na_glb,nr_glb;
6160   const PetscScalar *u,*y;
6161   PetscReal         sum,suma,sumr,gsum,gsuma,gsumr,diff;
6162   PetscReal         tol,tola,tolr;
6163   PetscReal         err_loc[6],err_glb[6];
6164 
6165   PetscFunctionBegin;
6166   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6167   PetscValidHeaderSpecific(U,VEC_CLASSID,2);
6168   PetscValidHeaderSpecific(Y,VEC_CLASSID,3);
6169   PetscValidType(U,2);
6170   PetscValidType(Y,3);
6171   PetscCheckSameComm(U,2,Y,3);
6172   PetscValidPointer(norm,4);
6173   PetscValidPointer(norma,5);
6174   PetscValidPointer(normr,6);
6175   if (U == Y) SETERRQ(PetscObjectComm((PetscObject)U),PETSC_ERR_ARG_IDN,"U and Y cannot be the same vector");
6176 
6177   ierr = VecGetSize(U,&N);CHKERRQ(ierr);
6178   ierr = VecGetLocalSize(U,&n);CHKERRQ(ierr);
6179   ierr = VecGetOwnershipRange(U,&rstart,NULL);CHKERRQ(ierr);
6180   ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
6181   ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
6182   sum  = 0.; n_loc  = 0;
6183   suma = 0.; na_loc = 0;
6184   sumr = 0.; nr_loc = 0;
6185   if (ts->vatol && ts->vrtol) {
6186     const PetscScalar *atol,*rtol;
6187     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6188     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6189     for (i=0; i<n; i++) {
6190       diff = PetscAbsScalar(y[i] - u[i]);
6191       tola = PetscRealPart(atol[i]);
6192       if(tola>0.){
6193         suma  += PetscSqr(diff/tola);
6194         na_loc++;
6195       }
6196       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6197       if(tolr>0.){
6198         sumr  += PetscSqr(diff/tolr);
6199         nr_loc++;
6200       }
6201       tol=tola+tolr;
6202       if(tol>0.){
6203         sum  += PetscSqr(diff/tol);
6204         n_loc++;
6205       }
6206     }
6207     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6208     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6209   } else if (ts->vatol) {       /* vector atol, scalar rtol */
6210     const PetscScalar *atol;
6211     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6212     for (i=0; i<n; i++) {
6213       diff = PetscAbsScalar(y[i] - u[i]);
6214       tola = PetscRealPart(atol[i]);
6215       if(tola>0.){
6216         suma  += PetscSqr(diff/tola);
6217         na_loc++;
6218       }
6219       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6220       if(tolr>0.){
6221         sumr  += PetscSqr(diff/tolr);
6222         nr_loc++;
6223       }
6224       tol=tola+tolr;
6225       if(tol>0.){
6226         sum  += PetscSqr(diff/tol);
6227         n_loc++;
6228       }
6229     }
6230     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6231   } else if (ts->vrtol) {       /* scalar atol, vector rtol */
6232     const PetscScalar *rtol;
6233     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6234     for (i=0; i<n; i++) {
6235       diff = PetscAbsScalar(y[i] - u[i]);
6236       tola = ts->atol;
6237       if(tola>0.){
6238         suma  += PetscSqr(diff/tola);
6239         na_loc++;
6240       }
6241       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6242       if(tolr>0.){
6243         sumr  += PetscSqr(diff/tolr);
6244         nr_loc++;
6245       }
6246       tol=tola+tolr;
6247       if(tol>0.){
6248         sum  += PetscSqr(diff/tol);
6249         n_loc++;
6250       }
6251     }
6252     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6253   } else {                      /* scalar atol, scalar rtol */
6254     for (i=0; i<n; i++) {
6255       diff = PetscAbsScalar(y[i] - u[i]);
6256      tola = ts->atol;
6257       if(tola>0.){
6258         suma  += PetscSqr(diff/tola);
6259         na_loc++;
6260       }
6261       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6262       if(tolr>0.){
6263         sumr  += PetscSqr(diff/tolr);
6264         nr_loc++;
6265       }
6266       tol=tola+tolr;
6267       if(tol>0.){
6268         sum  += PetscSqr(diff/tol);
6269         n_loc++;
6270       }
6271     }
6272   }
6273   ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
6274   ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
6275 
6276   err_loc[0] = sum;
6277   err_loc[1] = suma;
6278   err_loc[2] = sumr;
6279   err_loc[3] = (PetscReal)n_loc;
6280   err_loc[4] = (PetscReal)na_loc;
6281   err_loc[5] = (PetscReal)nr_loc;
6282 
6283   ierr = MPIU_Allreduce(err_loc,err_glb,6,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
6284 
6285   gsum   = err_glb[0];
6286   gsuma  = err_glb[1];
6287   gsumr  = err_glb[2];
6288   n_glb  = err_glb[3];
6289   na_glb = err_glb[4];
6290   nr_glb = err_glb[5];
6291 
6292   *norm  = 0.;
6293   if(n_glb>0. ){*norm  = PetscSqrtReal(gsum  / n_glb );}
6294   *norma = 0.;
6295   if(na_glb>0.){*norma = PetscSqrtReal(gsuma / na_glb);}
6296   *normr = 0.;
6297   if(nr_glb>0.){*normr = PetscSqrtReal(gsumr / nr_glb);}
6298 
6299   if (PetscIsInfOrNanScalar(*norm)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norm");
6300   if (PetscIsInfOrNanScalar(*norma)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norma");
6301   if (PetscIsInfOrNanScalar(*normr)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in normr");
6302   PetscFunctionReturn(0);
6303 }
6304 
6305 /*@
6306    TSErrorWeightedNormInfinity - compute a weighted infinity-norm of the difference between two state vectors
6307 
6308    Collective on TS
6309 
6310    Input Arguments:
6311 +  ts - time stepping context
6312 .  U - state vector, usually ts->vec_sol
6313 -  Y - state vector to be compared to U
6314 
6315    Output Arguments:
6316 .  norm - weighted norm, a value of 1.0 means that the error matches the tolerances
6317 .  norma - weighted norm based on the absolute tolerance, a value of 1.0 means that the error matches the tolerances
6318 .  normr - weighted norm based on the relative tolerance, a value of 1.0 means that the error matches the tolerances
6319 
6320    Level: developer
6321 
6322 .seealso: TSErrorWeightedNorm(), TSErrorWeightedNorm2()
6323 @*/
6324 PetscErrorCode TSErrorWeightedNormInfinity(TS ts,Vec U,Vec Y,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6325 {
6326   PetscErrorCode    ierr;
6327   PetscInt          i,n,N,rstart;
6328   const PetscScalar *u,*y;
6329   PetscReal         max,gmax,maxa,gmaxa,maxr,gmaxr;
6330   PetscReal         tol,tola,tolr,diff;
6331   PetscReal         err_loc[3],err_glb[3];
6332 
6333   PetscFunctionBegin;
6334   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6335   PetscValidHeaderSpecific(U,VEC_CLASSID,2);
6336   PetscValidHeaderSpecific(Y,VEC_CLASSID,3);
6337   PetscValidType(U,2);
6338   PetscValidType(Y,3);
6339   PetscCheckSameComm(U,2,Y,3);
6340   PetscValidPointer(norm,4);
6341   PetscValidPointer(norma,5);
6342   PetscValidPointer(normr,6);
6343   if (U == Y) SETERRQ(PetscObjectComm((PetscObject)U),PETSC_ERR_ARG_IDN,"U and Y cannot be the same vector");
6344 
6345   ierr = VecGetSize(U,&N);CHKERRQ(ierr);
6346   ierr = VecGetLocalSize(U,&n);CHKERRQ(ierr);
6347   ierr = VecGetOwnershipRange(U,&rstart,NULL);CHKERRQ(ierr);
6348   ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
6349   ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
6350 
6351   max=0.;
6352   maxa=0.;
6353   maxr=0.;
6354 
6355   if (ts->vatol && ts->vrtol) {     /* vector atol, vector rtol */
6356     const PetscScalar *atol,*rtol;
6357     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6358     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6359 
6360     for (i=0; i<n; i++) {
6361       diff = PetscAbsScalar(y[i] - u[i]);
6362       tola = PetscRealPart(atol[i]);
6363       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6364       tol  = tola+tolr;
6365       if(tola>0.){
6366         maxa = PetscMax(maxa,diff / tola);
6367       }
6368       if(tolr>0.){
6369         maxr = PetscMax(maxr,diff / tolr);
6370       }
6371       if(tol>0.){
6372         max = PetscMax(max,diff / tol);
6373       }
6374     }
6375     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6376     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6377   } else if (ts->vatol) {       /* vector atol, scalar rtol */
6378     const PetscScalar *atol;
6379     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6380     for (i=0; i<n; i++) {
6381       diff = PetscAbsScalar(y[i] - u[i]);
6382       tola = PetscRealPart(atol[i]);
6383       tolr = ts->rtol  * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6384       tol  = tola+tolr;
6385       if(tola>0.){
6386         maxa = PetscMax(maxa,diff / tola);
6387       }
6388       if(tolr>0.){
6389         maxr = PetscMax(maxr,diff / tolr);
6390       }
6391       if(tol>0.){
6392         max = PetscMax(max,diff / tol);
6393       }
6394     }
6395     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6396   } else if (ts->vrtol) {       /* scalar atol, vector rtol */
6397     const PetscScalar *rtol;
6398     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6399 
6400     for (i=0; i<n; i++) {
6401       diff = PetscAbsScalar(y[i] - u[i]);
6402       tola = ts->atol;
6403       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6404       tol  = tola+tolr;
6405       if(tola>0.){
6406         maxa = PetscMax(maxa,diff / tola);
6407       }
6408       if(tolr>0.){
6409         maxr = PetscMax(maxr,diff / tolr);
6410       }
6411       if(tol>0.){
6412         max = PetscMax(max,diff / tol);
6413       }
6414     }
6415     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6416   } else {                      /* scalar atol, scalar rtol */
6417 
6418     for (i=0; i<n; i++) {
6419       diff = PetscAbsScalar(y[i] - u[i]);
6420       tola = ts->atol;
6421       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6422       tol  = tola+tolr;
6423       if(tola>0.){
6424         maxa = PetscMax(maxa,diff / tola);
6425       }
6426       if(tolr>0.){
6427         maxr = PetscMax(maxr,diff / tolr);
6428       }
6429       if(tol>0.){
6430         max = PetscMax(max,diff / tol);
6431       }
6432     }
6433   }
6434   ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
6435   ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
6436   err_loc[0] = max;
6437   err_loc[1] = maxa;
6438   err_loc[2] = maxr;
6439   ierr  = MPIU_Allreduce(err_loc,err_glb,3,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
6440   gmax   = err_glb[0];
6441   gmaxa  = err_glb[1];
6442   gmaxr  = err_glb[2];
6443 
6444   *norm = gmax;
6445   *norma = gmaxa;
6446   *normr = gmaxr;
6447   if (PetscIsInfOrNanScalar(*norm)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norm");
6448     if (PetscIsInfOrNanScalar(*norma)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norma");
6449     if (PetscIsInfOrNanScalar(*normr)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in normr");
6450   PetscFunctionReturn(0);
6451 }
6452 
6453 /*@
6454    TSErrorWeightedNorm - compute a weighted norm of the difference between two state vectors based on supplied absolute and relative tolerances
6455 
6456    Collective on TS
6457 
6458    Input Arguments:
6459 +  ts - time stepping context
6460 .  U - state vector, usually ts->vec_sol
6461 .  Y - state vector to be compared to U
6462 -  wnormtype - norm type, either NORM_2 or NORM_INFINITY
6463 
6464    Output Arguments:
6465 .  norm  - weighted norm, a value of 1.0 achieves a balance between absolute and relative tolerances
6466 .  norma - weighted norm, a value of 1.0 means that the error meets the absolute tolerance set by the user
6467 .  normr - weighted norm, a value of 1.0 means that the error meets the relative tolerance set by the user
6468 
6469    Options Database Keys:
6470 .  -ts_adapt_wnormtype <wnormtype> - 2, INFINITY
6471 
6472    Level: developer
6473 
6474 .seealso: TSErrorWeightedNormInfinity(), TSErrorWeightedNorm2(), TSErrorWeightedENorm
6475 @*/
6476 PetscErrorCode TSErrorWeightedNorm(TS ts,Vec U,Vec Y,NormType wnormtype,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6477 {
6478   PetscErrorCode ierr;
6479 
6480   PetscFunctionBegin;
6481   if (wnormtype == NORM_2) {
6482     ierr = TSErrorWeightedNorm2(ts,U,Y,norm,norma,normr);CHKERRQ(ierr);
6483   } else if(wnormtype == NORM_INFINITY) {
6484     ierr = TSErrorWeightedNormInfinity(ts,U,Y,norm,norma,normr);CHKERRQ(ierr);
6485   } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for norm type %s",NormTypes[wnormtype]);
6486   PetscFunctionReturn(0);
6487 }
6488 
6489 
6490 /*@
6491    TSErrorWeightedENorm2 - compute a weighted 2 error norm based on supplied absolute and relative tolerances
6492 
6493    Collective on TS
6494 
6495    Input Arguments:
6496 +  ts - time stepping context
6497 .  E - error vector
6498 .  U - state vector, usually ts->vec_sol
6499 -  Y - state vector, previous time step
6500 
6501    Output Arguments:
6502 .  norm - weighted norm, a value of 1.0 means that the error matches the tolerances
6503 .  norma - weighted norm based on the absolute tolerance, a value of 1.0 means that the error matches the tolerances
6504 .  normr - weighted norm based on the relative tolerance, a value of 1.0 means that the error matches the tolerances
6505 
6506    Level: developer
6507 
6508 .seealso: TSErrorWeightedENorm(), TSErrorWeightedENormInfinity()
6509 @*/
6510 PetscErrorCode TSErrorWeightedENorm2(TS ts,Vec E,Vec U,Vec Y,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6511 {
6512   PetscErrorCode    ierr;
6513   PetscInt          i,n,N,rstart;
6514   PetscInt          n_loc,na_loc,nr_loc;
6515   PetscReal         n_glb,na_glb,nr_glb;
6516   const PetscScalar *e,*u,*y;
6517   PetscReal         err,sum,suma,sumr,gsum,gsuma,gsumr;
6518   PetscReal         tol,tola,tolr;
6519   PetscReal         err_loc[6],err_glb[6];
6520 
6521   PetscFunctionBegin;
6522   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6523   PetscValidHeaderSpecific(E,VEC_CLASSID,2);
6524   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
6525   PetscValidHeaderSpecific(Y,VEC_CLASSID,4);
6526   PetscValidType(E,2);
6527   PetscValidType(U,3);
6528   PetscValidType(Y,4);
6529   PetscCheckSameComm(E,2,U,3);
6530   PetscCheckSameComm(U,2,Y,3);
6531   PetscValidPointer(norm,5);
6532   PetscValidPointer(norma,6);
6533   PetscValidPointer(normr,7);
6534 
6535   ierr = VecGetSize(E,&N);CHKERRQ(ierr);
6536   ierr = VecGetLocalSize(E,&n);CHKERRQ(ierr);
6537   ierr = VecGetOwnershipRange(E,&rstart,NULL);CHKERRQ(ierr);
6538   ierr = VecGetArrayRead(E,&e);CHKERRQ(ierr);
6539   ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
6540   ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
6541   sum  = 0.; n_loc  = 0;
6542   suma = 0.; na_loc = 0;
6543   sumr = 0.; nr_loc = 0;
6544   if (ts->vatol && ts->vrtol) {
6545     const PetscScalar *atol,*rtol;
6546     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6547     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6548     for (i=0; i<n; i++) {
6549       err = PetscAbsScalar(e[i]);
6550       tola = PetscRealPart(atol[i]);
6551       if(tola>0.){
6552         suma  += PetscSqr(err/tola);
6553         na_loc++;
6554       }
6555       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6556       if(tolr>0.){
6557         sumr  += PetscSqr(err/tolr);
6558         nr_loc++;
6559       }
6560       tol=tola+tolr;
6561       if(tol>0.){
6562         sum  += PetscSqr(err/tol);
6563         n_loc++;
6564       }
6565     }
6566     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6567     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6568   } else if (ts->vatol) {       /* vector atol, scalar rtol */
6569     const PetscScalar *atol;
6570     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6571     for (i=0; i<n; i++) {
6572       err = PetscAbsScalar(e[i]);
6573       tola = PetscRealPart(atol[i]);
6574       if(tola>0.){
6575         suma  += PetscSqr(err/tola);
6576         na_loc++;
6577       }
6578       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6579       if(tolr>0.){
6580         sumr  += PetscSqr(err/tolr);
6581         nr_loc++;
6582       }
6583       tol=tola+tolr;
6584       if(tol>0.){
6585         sum  += PetscSqr(err/tol);
6586         n_loc++;
6587       }
6588     }
6589     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6590   } else if (ts->vrtol) {       /* scalar atol, vector rtol */
6591     const PetscScalar *rtol;
6592     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6593     for (i=0; i<n; i++) {
6594       err = PetscAbsScalar(e[i]);
6595       tola = ts->atol;
6596       if(tola>0.){
6597         suma  += PetscSqr(err/tola);
6598         na_loc++;
6599       }
6600       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6601       if(tolr>0.){
6602         sumr  += PetscSqr(err/tolr);
6603         nr_loc++;
6604       }
6605       tol=tola+tolr;
6606       if(tol>0.){
6607         sum  += PetscSqr(err/tol);
6608         n_loc++;
6609       }
6610     }
6611     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6612   } else {                      /* scalar atol, scalar rtol */
6613     for (i=0; i<n; i++) {
6614       err = PetscAbsScalar(e[i]);
6615      tola = ts->atol;
6616       if(tola>0.){
6617         suma  += PetscSqr(err/tola);
6618         na_loc++;
6619       }
6620       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6621       if(tolr>0.){
6622         sumr  += PetscSqr(err/tolr);
6623         nr_loc++;
6624       }
6625       tol=tola+tolr;
6626       if(tol>0.){
6627         sum  += PetscSqr(err/tol);
6628         n_loc++;
6629       }
6630     }
6631   }
6632   ierr = VecRestoreArrayRead(E,&e);CHKERRQ(ierr);
6633   ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
6634   ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
6635 
6636   err_loc[0] = sum;
6637   err_loc[1] = suma;
6638   err_loc[2] = sumr;
6639   err_loc[3] = (PetscReal)n_loc;
6640   err_loc[4] = (PetscReal)na_loc;
6641   err_loc[5] = (PetscReal)nr_loc;
6642 
6643   ierr = MPIU_Allreduce(err_loc,err_glb,6,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
6644 
6645   gsum   = err_glb[0];
6646   gsuma  = err_glb[1];
6647   gsumr  = err_glb[2];
6648   n_glb  = err_glb[3];
6649   na_glb = err_glb[4];
6650   nr_glb = err_glb[5];
6651 
6652   *norm  = 0.;
6653   if(n_glb>0. ){*norm  = PetscSqrtReal(gsum  / n_glb );}
6654   *norma = 0.;
6655   if(na_glb>0.){*norma = PetscSqrtReal(gsuma / na_glb);}
6656   *normr = 0.;
6657   if(nr_glb>0.){*normr = PetscSqrtReal(gsumr / nr_glb);}
6658 
6659   if (PetscIsInfOrNanScalar(*norm)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norm");
6660   if (PetscIsInfOrNanScalar(*norma)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norma");
6661   if (PetscIsInfOrNanScalar(*normr)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in normr");
6662   PetscFunctionReturn(0);
6663 }
6664 
6665 /*@
6666    TSErrorWeightedENormInfinity - compute a weighted infinity error norm based on supplied absolute and relative tolerances
6667    Collective on TS
6668 
6669    Input Arguments:
6670 +  ts - time stepping context
6671 .  E - error vector
6672 .  U - state vector, usually ts->vec_sol
6673 -  Y - state vector, previous time step
6674 
6675    Output Arguments:
6676 .  norm - weighted norm, a value of 1.0 means that the error matches the tolerances
6677 .  norma - weighted norm based on the absolute tolerance, a value of 1.0 means that the error matches the tolerances
6678 .  normr - weighted norm based on the relative tolerance, a value of 1.0 means that the error matches the tolerances
6679 
6680    Level: developer
6681 
6682 .seealso: TSErrorWeightedENorm(), TSErrorWeightedENorm2()
6683 @*/
6684 PetscErrorCode TSErrorWeightedENormInfinity(TS ts,Vec E,Vec U,Vec Y,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6685 {
6686   PetscErrorCode    ierr;
6687   PetscInt          i,n,N,rstart;
6688   const PetscScalar *e,*u,*y;
6689   PetscReal         err,max,gmax,maxa,gmaxa,maxr,gmaxr;
6690   PetscReal         tol,tola,tolr;
6691   PetscReal         err_loc[3],err_glb[3];
6692 
6693   PetscFunctionBegin;
6694   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6695   PetscValidHeaderSpecific(E,VEC_CLASSID,2);
6696   PetscValidHeaderSpecific(U,VEC_CLASSID,3);
6697   PetscValidHeaderSpecific(Y,VEC_CLASSID,4);
6698   PetscValidType(E,2);
6699   PetscValidType(U,3);
6700   PetscValidType(Y,4);
6701   PetscCheckSameComm(E,2,U,3);
6702   PetscCheckSameComm(U,2,Y,3);
6703   PetscValidPointer(norm,5);
6704   PetscValidPointer(norma,6);
6705   PetscValidPointer(normr,7);
6706 
6707   ierr = VecGetSize(E,&N);CHKERRQ(ierr);
6708   ierr = VecGetLocalSize(E,&n);CHKERRQ(ierr);
6709   ierr = VecGetOwnershipRange(E,&rstart,NULL);CHKERRQ(ierr);
6710   ierr = VecGetArrayRead(E,&e);CHKERRQ(ierr);
6711   ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
6712   ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
6713 
6714   max=0.;
6715   maxa=0.;
6716   maxr=0.;
6717 
6718   if (ts->vatol && ts->vrtol) {     /* vector atol, vector rtol */
6719     const PetscScalar *atol,*rtol;
6720     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6721     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6722 
6723     for (i=0; i<n; i++) {
6724       err = PetscAbsScalar(e[i]);
6725       tola = PetscRealPart(atol[i]);
6726       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6727       tol  = tola+tolr;
6728       if(tola>0.){
6729         maxa = PetscMax(maxa,err / tola);
6730       }
6731       if(tolr>0.){
6732         maxr = PetscMax(maxr,err / tolr);
6733       }
6734       if(tol>0.){
6735         max = PetscMax(max,err / tol);
6736       }
6737     }
6738     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6739     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6740   } else if (ts->vatol) {       /* vector atol, scalar rtol */
6741     const PetscScalar *atol;
6742     ierr = VecGetArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6743     for (i=0; i<n; i++) {
6744       err = PetscAbsScalar(e[i]);
6745       tola = PetscRealPart(atol[i]);
6746       tolr = ts->rtol  * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6747       tol  = tola+tolr;
6748       if(tola>0.){
6749         maxa = PetscMax(maxa,err / tola);
6750       }
6751       if(tolr>0.){
6752         maxr = PetscMax(maxr,err / tolr);
6753       }
6754       if(tol>0.){
6755         max = PetscMax(max,err / tol);
6756       }
6757     }
6758     ierr = VecRestoreArrayRead(ts->vatol,&atol);CHKERRQ(ierr);
6759   } else if (ts->vrtol) {       /* scalar atol, vector rtol */
6760     const PetscScalar *rtol;
6761     ierr = VecGetArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6762 
6763     for (i=0; i<n; i++) {
6764       err = PetscAbsScalar(e[i]);
6765       tola = ts->atol;
6766       tolr = PetscRealPart(rtol[i]) * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6767       tol  = tola+tolr;
6768       if(tola>0.){
6769         maxa = PetscMax(maxa,err / tola);
6770       }
6771       if(tolr>0.){
6772         maxr = PetscMax(maxr,err / tolr);
6773       }
6774       if(tol>0.){
6775         max = PetscMax(max,err / tol);
6776       }
6777     }
6778     ierr = VecRestoreArrayRead(ts->vrtol,&rtol);CHKERRQ(ierr);
6779   } else {                      /* scalar atol, scalar rtol */
6780 
6781     for (i=0; i<n; i++) {
6782       err = PetscAbsScalar(e[i]);
6783       tola = ts->atol;
6784       tolr = ts->rtol * PetscMax(PetscAbsScalar(u[i]),PetscAbsScalar(y[i]));
6785       tol  = tola+tolr;
6786       if(tola>0.){
6787         maxa = PetscMax(maxa,err / tola);
6788       }
6789       if(tolr>0.){
6790         maxr = PetscMax(maxr,err / tolr);
6791       }
6792       if(tol>0.){
6793         max = PetscMax(max,err / tol);
6794       }
6795     }
6796   }
6797   ierr = VecRestoreArrayRead(E,&e);CHKERRQ(ierr);
6798   ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
6799   ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
6800   err_loc[0] = max;
6801   err_loc[1] = maxa;
6802   err_loc[2] = maxr;
6803   ierr  = MPIU_Allreduce(err_loc,err_glb,3,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
6804   gmax   = err_glb[0];
6805   gmaxa  = err_glb[1];
6806   gmaxr  = err_glb[2];
6807 
6808   *norm = gmax;
6809   *norma = gmaxa;
6810   *normr = gmaxr;
6811   if (PetscIsInfOrNanScalar(*norm)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norm");
6812     if (PetscIsInfOrNanScalar(*norma)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in norma");
6813     if (PetscIsInfOrNanScalar(*normr)) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_FP,"Infinite or not-a-number generated in normr");
6814   PetscFunctionReturn(0);
6815 }
6816 
6817 /*@
6818    TSErrorWeightedENorm - compute a weighted error norm based on supplied absolute and relative tolerances
6819 
6820    Collective on TS
6821 
6822    Input Arguments:
6823 +  ts - time stepping context
6824 .  E - error vector
6825 .  U - state vector, usually ts->vec_sol
6826 .  Y - state vector, previous time step
6827 -  wnormtype - norm type, either NORM_2 or NORM_INFINITY
6828 
6829    Output Arguments:
6830 .  norm  - weighted norm, a value of 1.0 achieves a balance between absolute and relative tolerances
6831 .  norma - weighted norm, a value of 1.0 means that the error meets the absolute tolerance set by the user
6832 .  normr - weighted norm, a value of 1.0 means that the error meets the relative tolerance set by the user
6833 
6834    Options Database Keys:
6835 .  -ts_adapt_wnormtype <wnormtype> - 2, INFINITY
6836 
6837    Level: developer
6838 
6839 .seealso: TSErrorWeightedENormInfinity(), TSErrorWeightedENorm2(), TSErrorWeightedNormInfinity(), TSErrorWeightedNorm2()
6840 @*/
6841 PetscErrorCode TSErrorWeightedENorm(TS ts,Vec E,Vec U,Vec Y,NormType wnormtype,PetscReal *norm,PetscReal *norma,PetscReal *normr)
6842 {
6843   PetscErrorCode ierr;
6844 
6845   PetscFunctionBegin;
6846   if (wnormtype == NORM_2) {
6847     ierr = TSErrorWeightedENorm2(ts,E,U,Y,norm,norma,normr);CHKERRQ(ierr);
6848   } else if(wnormtype == NORM_INFINITY) {
6849     ierr = TSErrorWeightedENormInfinity(ts,E,U,Y,norm,norma,normr);CHKERRQ(ierr);
6850   } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for norm type %s",NormTypes[wnormtype]);
6851   PetscFunctionReturn(0);
6852 }
6853 
6854 
6855 /*@
6856    TSSetCFLTimeLocal - Set the local CFL constraint relative to forward Euler
6857 
6858    Logically Collective on TS
6859 
6860    Input Arguments:
6861 +  ts - time stepping context
6862 -  cfltime - maximum stable time step if using forward Euler (value can be different on each process)
6863 
6864    Note:
6865    After calling this function, the global CFL time can be obtained by calling TSGetCFLTime()
6866 
6867    Level: intermediate
6868 
6869 .seealso: TSGetCFLTime(), TSADAPTCFL
6870 @*/
6871 PetscErrorCode TSSetCFLTimeLocal(TS ts,PetscReal cfltime)
6872 {
6873   PetscFunctionBegin;
6874   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
6875   ts->cfltime_local = cfltime;
6876   ts->cfltime       = -1.;
6877   PetscFunctionReturn(0);
6878 }
6879 
6880 /*@
6881    TSGetCFLTime - Get the maximum stable time step according to CFL criteria applied to forward Euler
6882 
6883    Collective on TS
6884 
6885    Input Arguments:
6886 .  ts - time stepping context
6887 
6888    Output Arguments:
6889 .  cfltime - maximum stable time step for forward Euler
6890 
6891    Level: advanced
6892 
6893 .seealso: TSSetCFLTimeLocal()
6894 @*/
6895 PetscErrorCode TSGetCFLTime(TS ts,PetscReal *cfltime)
6896 {
6897   PetscErrorCode ierr;
6898 
6899   PetscFunctionBegin;
6900   if (ts->cfltime < 0) {
6901     ierr = MPIU_Allreduce(&ts->cfltime_local,&ts->cfltime,1,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
6902   }
6903   *cfltime = ts->cfltime;
6904   PetscFunctionReturn(0);
6905 }
6906 
6907 /*@
6908    TSVISetVariableBounds - Sets the lower and upper bounds for the solution vector. xl <= x <= xu
6909 
6910    Input Parameters:
6911 .  ts   - the TS context.
6912 .  xl   - lower bound.
6913 .  xu   - upper bound.
6914 
6915    Notes:
6916    If this routine is not called then the lower and upper bounds are set to
6917    PETSC_NINFINITY and PETSC_INFINITY respectively during SNESSetUp().
6918 
6919    Level: advanced
6920 
6921 @*/
6922 PetscErrorCode TSVISetVariableBounds(TS ts, Vec xl, Vec xu)
6923 {
6924   PetscErrorCode ierr;
6925   SNES           snes;
6926 
6927   PetscFunctionBegin;
6928   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
6929   ierr = SNESVISetVariableBounds(snes,xl,xu);CHKERRQ(ierr);
6930   PetscFunctionReturn(0);
6931 }
6932 
6933 #if defined(PETSC_HAVE_MATLAB_ENGINE)
6934 #include <mex.h>
6935 
6936 typedef struct {char *funcname; mxArray *ctx;} TSMatlabContext;
6937 
6938 /*
6939    TSComputeFunction_Matlab - Calls the function that has been set with
6940                          TSSetFunctionMatlab().
6941 
6942    Collective on TS
6943 
6944    Input Parameters:
6945 +  snes - the TS context
6946 -  u - input vector
6947 
6948    Output Parameter:
6949 .  y - function vector, as set by TSSetFunction()
6950 
6951    Notes:
6952    TSComputeFunction() is typically used within nonlinear solvers
6953    implementations, so most users would not generally call this routine
6954    themselves.
6955 
6956    Level: developer
6957 
6958 .keywords: TS, nonlinear, compute, function
6959 
6960 .seealso: TSSetFunction(), TSGetFunction()
6961 */
6962 PetscErrorCode  TSComputeFunction_Matlab(TS snes,PetscReal time,Vec u,Vec udot,Vec y, void *ctx)
6963 {
6964   PetscErrorCode  ierr;
6965   TSMatlabContext *sctx = (TSMatlabContext*)ctx;
6966   int             nlhs  = 1,nrhs = 7;
6967   mxArray         *plhs[1],*prhs[7];
6968   long long int   lx = 0,lxdot = 0,ly = 0,ls = 0;
6969 
6970   PetscFunctionBegin;
6971   PetscValidHeaderSpecific(snes,TS_CLASSID,1);
6972   PetscValidHeaderSpecific(u,VEC_CLASSID,3);
6973   PetscValidHeaderSpecific(udot,VEC_CLASSID,4);
6974   PetscValidHeaderSpecific(y,VEC_CLASSID,5);
6975   PetscCheckSameComm(snes,1,u,3);
6976   PetscCheckSameComm(snes,1,y,5);
6977 
6978   ierr = PetscMemcpy(&ls,&snes,sizeof(snes));CHKERRQ(ierr);
6979   ierr = PetscMemcpy(&lx,&u,sizeof(u));CHKERRQ(ierr);
6980   ierr = PetscMemcpy(&lxdot,&udot,sizeof(udot));CHKERRQ(ierr);
6981   ierr = PetscMemcpy(&ly,&y,sizeof(u));CHKERRQ(ierr);
6982 
6983   prhs[0] =  mxCreateDoubleScalar((double)ls);
6984   prhs[1] =  mxCreateDoubleScalar(time);
6985   prhs[2] =  mxCreateDoubleScalar((double)lx);
6986   prhs[3] =  mxCreateDoubleScalar((double)lxdot);
6987   prhs[4] =  mxCreateDoubleScalar((double)ly);
6988   prhs[5] =  mxCreateString(sctx->funcname);
6989   prhs[6] =  sctx->ctx;
6990   ierr    =  mexCallMATLAB(nlhs,plhs,nrhs,prhs,"PetscTSComputeFunctionInternal");CHKERRQ(ierr);
6991   ierr    =  mxGetScalar(plhs[0]);CHKERRQ(ierr);
6992   mxDestroyArray(prhs[0]);
6993   mxDestroyArray(prhs[1]);
6994   mxDestroyArray(prhs[2]);
6995   mxDestroyArray(prhs[3]);
6996   mxDestroyArray(prhs[4]);
6997   mxDestroyArray(prhs[5]);
6998   mxDestroyArray(plhs[0]);
6999   PetscFunctionReturn(0);
7000 }
7001 
7002 /*
7003    TSSetFunctionMatlab - Sets the function evaluation routine and function
7004    vector for use by the TS routines in solving ODEs
7005    equations from MATLAB. Here the function is a string containing the name of a MATLAB function
7006 
7007    Logically Collective on TS
7008 
7009    Input Parameters:
7010 +  ts - the TS context
7011 -  func - function evaluation routine
7012 
7013    Calling sequence of func:
7014 $    func (TS ts,PetscReal time,Vec u,Vec udot,Vec f,void *ctx);
7015 
7016    Level: beginner
7017 
7018 .keywords: TS, nonlinear, set, function
7019 
7020 .seealso: TSGetFunction(), TSComputeFunction(), TSSetJacobian(), TSSetFunction()
7021 */
7022 PetscErrorCode  TSSetFunctionMatlab(TS ts,const char *func,mxArray *ctx)
7023 {
7024   PetscErrorCode  ierr;
7025   TSMatlabContext *sctx;
7026 
7027   PetscFunctionBegin;
7028   /* currently sctx is memory bleed */
7029   ierr = PetscNew(&sctx);CHKERRQ(ierr);
7030   ierr = PetscStrallocpy(func,&sctx->funcname);CHKERRQ(ierr);
7031   /*
7032      This should work, but it doesn't
7033   sctx->ctx = ctx;
7034   mexMakeArrayPersistent(sctx->ctx);
7035   */
7036   sctx->ctx = mxDuplicateArray(ctx);
7037 
7038   ierr = TSSetIFunction(ts,NULL,TSComputeFunction_Matlab,sctx);CHKERRQ(ierr);
7039   PetscFunctionReturn(0);
7040 }
7041 
7042 /*
7043    TSComputeJacobian_Matlab - Calls the function that has been set with
7044                          TSSetJacobianMatlab().
7045 
7046    Collective on TS
7047 
7048    Input Parameters:
7049 +  ts - the TS context
7050 .  u - input vector
7051 .  A, B - the matrices
7052 -  ctx - user context
7053 
7054    Level: developer
7055 
7056 .keywords: TS, nonlinear, compute, function
7057 
7058 .seealso: TSSetFunction(), TSGetFunction()
7059 @*/
7060 PetscErrorCode  TSComputeJacobian_Matlab(TS ts,PetscReal time,Vec u,Vec udot,PetscReal shift,Mat A,Mat B,void *ctx)
7061 {
7062   PetscErrorCode  ierr;
7063   TSMatlabContext *sctx = (TSMatlabContext*)ctx;
7064   int             nlhs  = 2,nrhs = 9;
7065   mxArray         *plhs[2],*prhs[9];
7066   long long int   lx = 0,lxdot = 0,lA = 0,ls = 0, lB = 0;
7067 
7068   PetscFunctionBegin;
7069   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
7070   PetscValidHeaderSpecific(u,VEC_CLASSID,3);
7071 
7072   /* call Matlab function in ctx with arguments u and y */
7073 
7074   ierr = PetscMemcpy(&ls,&ts,sizeof(ts));CHKERRQ(ierr);
7075   ierr = PetscMemcpy(&lx,&u,sizeof(u));CHKERRQ(ierr);
7076   ierr = PetscMemcpy(&lxdot,&udot,sizeof(u));CHKERRQ(ierr);
7077   ierr = PetscMemcpy(&lA,A,sizeof(u));CHKERRQ(ierr);
7078   ierr = PetscMemcpy(&lB,B,sizeof(u));CHKERRQ(ierr);
7079 
7080   prhs[0] =  mxCreateDoubleScalar((double)ls);
7081   prhs[1] =  mxCreateDoubleScalar((double)time);
7082   prhs[2] =  mxCreateDoubleScalar((double)lx);
7083   prhs[3] =  mxCreateDoubleScalar((double)lxdot);
7084   prhs[4] =  mxCreateDoubleScalar((double)shift);
7085   prhs[5] =  mxCreateDoubleScalar((double)lA);
7086   prhs[6] =  mxCreateDoubleScalar((double)lB);
7087   prhs[7] =  mxCreateString(sctx->funcname);
7088   prhs[8] =  sctx->ctx;
7089   ierr    =  mexCallMATLAB(nlhs,plhs,nrhs,prhs,"PetscTSComputeJacobianInternal");CHKERRQ(ierr);
7090   ierr    =  mxGetScalar(plhs[0]);CHKERRQ(ierr);
7091   mxDestroyArray(prhs[0]);
7092   mxDestroyArray(prhs[1]);
7093   mxDestroyArray(prhs[2]);
7094   mxDestroyArray(prhs[3]);
7095   mxDestroyArray(prhs[4]);
7096   mxDestroyArray(prhs[5]);
7097   mxDestroyArray(prhs[6]);
7098   mxDestroyArray(prhs[7]);
7099   mxDestroyArray(plhs[0]);
7100   mxDestroyArray(plhs[1]);
7101   PetscFunctionReturn(0);
7102 }
7103 
7104 /*
7105    TSSetJacobianMatlab - Sets the Jacobian function evaluation routine and two empty Jacobian matrices
7106    vector for use by the TS routines in solving ODEs from MATLAB. Here the function is a string containing the name of a MATLAB function
7107 
7108    Logically Collective on TS
7109 
7110    Input Parameters:
7111 +  ts - the TS context
7112 .  A,B - Jacobian matrices
7113 .  func - function evaluation routine
7114 -  ctx - user context
7115 
7116    Calling sequence of func:
7117 $    flag = func (TS ts,PetscReal time,Vec u,Vec udot,Mat A,Mat B,void *ctx);
7118 
7119    Level: developer
7120 
7121 .keywords: TS, nonlinear, set, function
7122 
7123 .seealso: TSGetFunction(), TSComputeFunction(), TSSetJacobian(), TSSetFunction()
7124 */
7125 PetscErrorCode  TSSetJacobianMatlab(TS ts,Mat A,Mat B,const char *func,mxArray *ctx)
7126 {
7127   PetscErrorCode  ierr;
7128   TSMatlabContext *sctx;
7129 
7130   PetscFunctionBegin;
7131   /* currently sctx is memory bleed */
7132   ierr = PetscNew(&sctx);CHKERRQ(ierr);
7133   ierr = PetscStrallocpy(func,&sctx->funcname);CHKERRQ(ierr);
7134   /*
7135      This should work, but it doesn't
7136   sctx->ctx = ctx;
7137   mexMakeArrayPersistent(sctx->ctx);
7138   */
7139   sctx->ctx = mxDuplicateArray(ctx);
7140 
7141   ierr = TSSetIJacobian(ts,A,B,TSComputeJacobian_Matlab,sctx);CHKERRQ(ierr);
7142   PetscFunctionReturn(0);
7143 }
7144 
7145 /*
7146    TSMonitor_Matlab - Calls the function that has been set with TSMonitorSetMatlab().
7147 
7148    Collective on TS
7149 
7150 .seealso: TSSetFunction(), TSGetFunction()
7151 @*/
7152 PetscErrorCode  TSMonitor_Matlab(TS ts,PetscInt it, PetscReal time,Vec u, void *ctx)
7153 {
7154   PetscErrorCode  ierr;
7155   TSMatlabContext *sctx = (TSMatlabContext*)ctx;
7156   int             nlhs  = 1,nrhs = 6;
7157   mxArray         *plhs[1],*prhs[6];
7158   long long int   lx = 0,ls = 0;
7159 
7160   PetscFunctionBegin;
7161   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
7162   PetscValidHeaderSpecific(u,VEC_CLASSID,4);
7163 
7164   ierr = PetscMemcpy(&ls,&ts,sizeof(ts));CHKERRQ(ierr);
7165   ierr = PetscMemcpy(&lx,&u,sizeof(u));CHKERRQ(ierr);
7166 
7167   prhs[0] =  mxCreateDoubleScalar((double)ls);
7168   prhs[1] =  mxCreateDoubleScalar((double)it);
7169   prhs[2] =  mxCreateDoubleScalar((double)time);
7170   prhs[3] =  mxCreateDoubleScalar((double)lx);
7171   prhs[4] =  mxCreateString(sctx->funcname);
7172   prhs[5] =  sctx->ctx;
7173   ierr    =  mexCallMATLAB(nlhs,plhs,nrhs,prhs,"PetscTSMonitorInternal");CHKERRQ(ierr);
7174   ierr    =  mxGetScalar(plhs[0]);CHKERRQ(ierr);
7175   mxDestroyArray(prhs[0]);
7176   mxDestroyArray(prhs[1]);
7177   mxDestroyArray(prhs[2]);
7178   mxDestroyArray(prhs[3]);
7179   mxDestroyArray(prhs[4]);
7180   mxDestroyArray(plhs[0]);
7181   PetscFunctionReturn(0);
7182 }
7183 
7184 /*
7185    TSMonitorSetMatlab - Sets the monitor function from Matlab
7186 
7187    Level: developer
7188 
7189 .keywords: TS, nonlinear, set, function
7190 
7191 .seealso: TSGetFunction(), TSComputeFunction(), TSSetJacobian(), TSSetFunction()
7192 */
7193 PetscErrorCode  TSMonitorSetMatlab(TS ts,const char *func,mxArray *ctx)
7194 {
7195   PetscErrorCode  ierr;
7196   TSMatlabContext *sctx;
7197 
7198   PetscFunctionBegin;
7199   /* currently sctx is memory bleed */
7200   ierr = PetscNew(&sctx);CHKERRQ(ierr);
7201   ierr = PetscStrallocpy(func,&sctx->funcname);CHKERRQ(ierr);
7202   /*
7203      This should work, but it doesn't
7204   sctx->ctx = ctx;
7205   mexMakeArrayPersistent(sctx->ctx);
7206   */
7207   sctx->ctx = mxDuplicateArray(ctx);
7208 
7209   ierr = TSMonitorSet(ts,TSMonitor_Matlab,sctx,NULL);CHKERRQ(ierr);
7210   PetscFunctionReturn(0);
7211 }
7212 #endif
7213 
7214 /*@C
7215    TSMonitorLGSolution - Monitors progress of the TS solvers by plotting each component of the solution vector
7216        in a time based line graph
7217 
7218    Collective on TS
7219 
7220    Input Parameters:
7221 +  ts - the TS context
7222 .  step - current time-step
7223 .  ptime - current time
7224 .  u - current solution
7225 -  dctx - the TSMonitorLGCtx object that contains all the options for the monitoring, this is created with TSMonitorLGCtxCreate()
7226 
7227    Options Database:
7228 .   -ts_monitor_lg_solution_variables
7229 
7230    Level: intermediate
7231 
7232    Notes: Each process in a parallel run displays its component solutions in a separate window
7233 
7234 .keywords: TS,  vector, monitor, view
7235 
7236 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGCtxCreate(), TSMonitorLGCtxSetVariableNames(), TSMonitorLGCtxGetVariableNames(),
7237            TSMonitorLGSetVariableNames(), TSMonitorLGGetVariableNames(), TSMonitorLGSetDisplayVariables(), TSMonitorLGCtxSetDisplayVariables(),
7238            TSMonitorLGCtxSetTransform(), TSMonitorLGSetTransform(), TSMonitorLGError(), TSMonitorLGSNESIterations(), TSMonitorLGKSPIterations(),
7239            TSMonitorEnvelopeCtxCreate(), TSMonitorEnvelopeGetBounds(), TSMonitorEnvelopeCtxDestroy(), TSMonitorEnvelop()
7240 @*/
7241 PetscErrorCode  TSMonitorLGSolution(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dctx)
7242 {
7243   PetscErrorCode    ierr;
7244   TSMonitorLGCtx    ctx = (TSMonitorLGCtx)dctx;
7245   const PetscScalar *yy;
7246   Vec               v;
7247 
7248   PetscFunctionBegin;
7249   if (step < 0) PetscFunctionReturn(0); /* -1 indicates interpolated solution */
7250   if (!step) {
7251     PetscDrawAxis axis;
7252     PetscInt      dim;
7253     ierr = PetscDrawLGGetAxis(ctx->lg,&axis);CHKERRQ(ierr);
7254     ierr = PetscDrawAxisSetLabels(axis,"Solution as function of time","Time","Solution");CHKERRQ(ierr);
7255     if (!ctx->names) {
7256       PetscBool flg;
7257       /* user provides names of variables to plot but no names has been set so assume names are integer values */
7258       ierr = PetscOptionsHasName(((PetscObject)ts)->options,((PetscObject)ts)->prefix,"-ts_monitor_lg_solution_variables",&flg);CHKERRQ(ierr);
7259       if (flg) {
7260         PetscInt i,n;
7261         char     **names;
7262         ierr = VecGetSize(u,&n);CHKERRQ(ierr);
7263         ierr = PetscMalloc1(n+1,&names);CHKERRQ(ierr);
7264         for (i=0; i<n; i++) {
7265           ierr = PetscMalloc1(5,&names[i]);CHKERRQ(ierr);
7266           ierr = PetscSNPrintf(names[i],5,"%D",i);CHKERRQ(ierr);
7267         }
7268         names[n] = NULL;
7269         ctx->names = names;
7270       }
7271     }
7272     if (ctx->names && !ctx->displaynames) {
7273       char      **displaynames;
7274       PetscBool flg;
7275       ierr = VecGetLocalSize(u,&dim);CHKERRQ(ierr);
7276       ierr = PetscMalloc1(dim+1,&displaynames);CHKERRQ(ierr);
7277       ierr = PetscMemzero(displaynames,(dim+1)*sizeof(char*));CHKERRQ(ierr);
7278       ierr = PetscOptionsGetStringArray(((PetscObject)ts)->options,((PetscObject)ts)->prefix,"-ts_monitor_lg_solution_variables",displaynames,&dim,&flg);CHKERRQ(ierr);
7279       if (flg) {
7280         ierr = TSMonitorLGCtxSetDisplayVariables(ctx,(const char *const *)displaynames);CHKERRQ(ierr);
7281       }
7282       ierr = PetscStrArrayDestroy(&displaynames);CHKERRQ(ierr);
7283     }
7284     if (ctx->displaynames) {
7285       ierr = PetscDrawLGSetDimension(ctx->lg,ctx->ndisplayvariables);CHKERRQ(ierr);
7286       ierr = PetscDrawLGSetLegend(ctx->lg,(const char *const *)ctx->displaynames);CHKERRQ(ierr);
7287     } else if (ctx->names) {
7288       ierr = VecGetLocalSize(u,&dim);CHKERRQ(ierr);
7289       ierr = PetscDrawLGSetDimension(ctx->lg,dim);CHKERRQ(ierr);
7290       ierr = PetscDrawLGSetLegend(ctx->lg,(const char *const *)ctx->names);CHKERRQ(ierr);
7291     } else {
7292       ierr = VecGetLocalSize(u,&dim);CHKERRQ(ierr);
7293       ierr = PetscDrawLGSetDimension(ctx->lg,dim);CHKERRQ(ierr);
7294     }
7295     ierr = PetscDrawLGReset(ctx->lg);CHKERRQ(ierr);
7296   }
7297 
7298   if (!ctx->transform) v = u;
7299   else {ierr = (*ctx->transform)(ctx->transformctx,u,&v);CHKERRQ(ierr);}
7300   ierr = VecGetArrayRead(v,&yy);CHKERRQ(ierr);
7301   if (ctx->displaynames) {
7302     PetscInt i;
7303     for (i=0; i<ctx->ndisplayvariables; i++)
7304       ctx->displayvalues[i] = PetscRealPart(yy[ctx->displayvariables[i]]);
7305     ierr = PetscDrawLGAddCommonPoint(ctx->lg,ptime,ctx->displayvalues);CHKERRQ(ierr);
7306   } else {
7307 #if defined(PETSC_USE_COMPLEX)
7308     PetscInt  i,n;
7309     PetscReal *yreal;
7310     ierr = VecGetLocalSize(v,&n);CHKERRQ(ierr);
7311     ierr = PetscMalloc1(n,&yreal);CHKERRQ(ierr);
7312     for (i=0; i<n; i++) yreal[i] = PetscRealPart(yy[i]);
7313     ierr = PetscDrawLGAddCommonPoint(ctx->lg,ptime,yreal);CHKERRQ(ierr);
7314     ierr = PetscFree(yreal);CHKERRQ(ierr);
7315 #else
7316     ierr = PetscDrawLGAddCommonPoint(ctx->lg,ptime,yy);CHKERRQ(ierr);
7317 #endif
7318   }
7319   ierr = VecRestoreArrayRead(v,&yy);CHKERRQ(ierr);
7320   if (ctx->transform) {ierr = VecDestroy(&v);CHKERRQ(ierr);}
7321 
7322   if (((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason)) {
7323     ierr = PetscDrawLGDraw(ctx->lg);CHKERRQ(ierr);
7324     ierr = PetscDrawLGSave(ctx->lg);CHKERRQ(ierr);
7325   }
7326   PetscFunctionReturn(0);
7327 }
7328 
7329 /*@C
7330    TSMonitorLGSetVariableNames - Sets the name of each component in the solution vector so that it may be displayed in the plot
7331 
7332    Collective on TS
7333 
7334    Input Parameters:
7335 +  ts - the TS context
7336 -  names - the names of the components, final string must be NULL
7337 
7338    Level: intermediate
7339 
7340    Notes: If the TS object does not have a TSMonitorLGCtx associated with it then this function is ignored
7341 
7342 .keywords: TS,  vector, monitor, view
7343 
7344 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetDisplayVariables(), TSMonitorLGCtxSetVariableNames()
7345 @*/
7346 PetscErrorCode  TSMonitorLGSetVariableNames(TS ts,const char * const *names)
7347 {
7348   PetscErrorCode    ierr;
7349   PetscInt          i;
7350 
7351   PetscFunctionBegin;
7352   for (i=0; i<ts->numbermonitors; i++) {
7353     if (ts->monitor[i] == TSMonitorLGSolution) {
7354       ierr = TSMonitorLGCtxSetVariableNames((TSMonitorLGCtx)ts->monitorcontext[i],names);CHKERRQ(ierr);
7355       break;
7356     }
7357   }
7358   PetscFunctionReturn(0);
7359 }
7360 
7361 /*@C
7362    TSMonitorLGCtxSetVariableNames - Sets the name of each component in the solution vector so that it may be displayed in the plot
7363 
7364    Collective on TS
7365 
7366    Input Parameters:
7367 +  ts - the TS context
7368 -  names - the names of the components, final string must be NULL
7369 
7370    Level: intermediate
7371 
7372 .keywords: TS,  vector, monitor, view
7373 
7374 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetDisplayVariables(), TSMonitorLGSetVariableNames()
7375 @*/
7376 PetscErrorCode  TSMonitorLGCtxSetVariableNames(TSMonitorLGCtx ctx,const char * const *names)
7377 {
7378   PetscErrorCode    ierr;
7379 
7380   PetscFunctionBegin;
7381   ierr = PetscStrArrayDestroy(&ctx->names);CHKERRQ(ierr);
7382   ierr = PetscStrArrayallocpy(names,&ctx->names);CHKERRQ(ierr);
7383   PetscFunctionReturn(0);
7384 }
7385 
7386 /*@C
7387    TSMonitorLGGetVariableNames - Gets the name of each component in the solution vector so that it may be displayed in the plot
7388 
7389    Collective on TS
7390 
7391    Input Parameter:
7392 .  ts - the TS context
7393 
7394    Output Parameter:
7395 .  names - the names of the components, final string must be NULL
7396 
7397    Level: intermediate
7398 
7399    Notes: If the TS object does not have a TSMonitorLGCtx associated with it then this function is ignored
7400 
7401 .keywords: TS,  vector, monitor, view
7402 
7403 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetDisplayVariables()
7404 @*/
7405 PetscErrorCode  TSMonitorLGGetVariableNames(TS ts,const char *const **names)
7406 {
7407   PetscInt       i;
7408 
7409   PetscFunctionBegin;
7410   *names = NULL;
7411   for (i=0; i<ts->numbermonitors; i++) {
7412     if (ts->monitor[i] == TSMonitorLGSolution) {
7413       TSMonitorLGCtx  ctx = (TSMonitorLGCtx) ts->monitorcontext[i];
7414       *names = (const char *const *)ctx->names;
7415       break;
7416     }
7417   }
7418   PetscFunctionReturn(0);
7419 }
7420 
7421 /*@C
7422    TSMonitorLGCtxSetDisplayVariables - Sets the variables that are to be display in the monitor
7423 
7424    Collective on TS
7425 
7426    Input Parameters:
7427 +  ctx - the TSMonitorLG context
7428 .  displaynames - the names of the components, final string must be NULL
7429 
7430    Level: intermediate
7431 
7432 .keywords: TS,  vector, monitor, view
7433 
7434 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetVariableNames()
7435 @*/
7436 PetscErrorCode  TSMonitorLGCtxSetDisplayVariables(TSMonitorLGCtx ctx,const char * const *displaynames)
7437 {
7438   PetscInt          j = 0,k;
7439   PetscErrorCode    ierr;
7440 
7441   PetscFunctionBegin;
7442   if (!ctx->names) PetscFunctionReturn(0);
7443   ierr = PetscStrArrayDestroy(&ctx->displaynames);CHKERRQ(ierr);
7444   ierr = PetscStrArrayallocpy(displaynames,&ctx->displaynames);CHKERRQ(ierr);
7445   while (displaynames[j]) j++;
7446   ctx->ndisplayvariables = j;
7447   ierr = PetscMalloc1(ctx->ndisplayvariables,&ctx->displayvariables);CHKERRQ(ierr);
7448   ierr = PetscMalloc1(ctx->ndisplayvariables,&ctx->displayvalues);CHKERRQ(ierr);
7449   j = 0;
7450   while (displaynames[j]) {
7451     k = 0;
7452     while (ctx->names[k]) {
7453       PetscBool flg;
7454       ierr = PetscStrcmp(displaynames[j],ctx->names[k],&flg);CHKERRQ(ierr);
7455       if (flg) {
7456         ctx->displayvariables[j] = k;
7457         break;
7458       }
7459       k++;
7460     }
7461     j++;
7462   }
7463   PetscFunctionReturn(0);
7464 }
7465 
7466 /*@C
7467    TSMonitorLGSetDisplayVariables - Sets the variables that are to be display in the monitor
7468 
7469    Collective on TS
7470 
7471    Input Parameters:
7472 +  ts - the TS context
7473 .  displaynames - the names of the components, final string must be NULL
7474 
7475    Notes: If the TS object does not have a TSMonitorLGCtx associated with it then this function is ignored
7476 
7477    Level: intermediate
7478 
7479 .keywords: TS,  vector, monitor, view
7480 
7481 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetVariableNames()
7482 @*/
7483 PetscErrorCode  TSMonitorLGSetDisplayVariables(TS ts,const char * const *displaynames)
7484 {
7485   PetscInt          i;
7486   PetscErrorCode    ierr;
7487 
7488   PetscFunctionBegin;
7489   for (i=0; i<ts->numbermonitors; i++) {
7490     if (ts->monitor[i] == TSMonitorLGSolution) {
7491       ierr = TSMonitorLGCtxSetDisplayVariables((TSMonitorLGCtx)ts->monitorcontext[i],displaynames);CHKERRQ(ierr);
7492       break;
7493     }
7494   }
7495   PetscFunctionReturn(0);
7496 }
7497 
7498 /*@C
7499    TSMonitorLGSetTransform - Solution vector will be transformed by provided function before being displayed
7500 
7501    Collective on TS
7502 
7503    Input Parameters:
7504 +  ts - the TS context
7505 .  transform - the transform function
7506 .  destroy - function to destroy the optional context
7507 -  ctx - optional context used by transform function
7508 
7509    Notes: If the TS object does not have a TSMonitorLGCtx associated with it then this function is ignored
7510 
7511    Level: intermediate
7512 
7513 .keywords: TS,  vector, monitor, view
7514 
7515 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetVariableNames(), TSMonitorLGCtxSetTransform()
7516 @*/
7517 PetscErrorCode  TSMonitorLGSetTransform(TS ts,PetscErrorCode (*transform)(void*,Vec,Vec*),PetscErrorCode (*destroy)(void*),void *tctx)
7518 {
7519   PetscInt          i;
7520   PetscErrorCode    ierr;
7521 
7522   PetscFunctionBegin;
7523   for (i=0; i<ts->numbermonitors; i++) {
7524     if (ts->monitor[i] == TSMonitorLGSolution) {
7525       ierr = TSMonitorLGCtxSetTransform((TSMonitorLGCtx)ts->monitorcontext[i],transform,destroy,tctx);CHKERRQ(ierr);
7526     }
7527   }
7528   PetscFunctionReturn(0);
7529 }
7530 
7531 /*@C
7532    TSMonitorLGCtxSetTransform - Solution vector will be transformed by provided function before being displayed
7533 
7534    Collective on TSLGCtx
7535 
7536    Input Parameters:
7537 +  ts - the TS context
7538 .  transform - the transform function
7539 .  destroy - function to destroy the optional context
7540 -  ctx - optional context used by transform function
7541 
7542    Level: intermediate
7543 
7544 .keywords: TS,  vector, monitor, view
7545 
7546 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetVariableNames(), TSMonitorLGSetTransform()
7547 @*/
7548 PetscErrorCode  TSMonitorLGCtxSetTransform(TSMonitorLGCtx ctx,PetscErrorCode (*transform)(void*,Vec,Vec*),PetscErrorCode (*destroy)(void*),void *tctx)
7549 {
7550   PetscFunctionBegin;
7551   ctx->transform    = transform;
7552   ctx->transformdestroy = destroy;
7553   ctx->transformctx = tctx;
7554   PetscFunctionReturn(0);
7555 }
7556 
7557 /*@C
7558    TSMonitorLGError - Monitors progress of the TS solvers by plotting each component of the error
7559        in a time based line graph
7560 
7561    Collective on TS
7562 
7563    Input Parameters:
7564 +  ts - the TS context
7565 .  step - current time-step
7566 .  ptime - current time
7567 .  u - current solution
7568 -  dctx - TSMonitorLGCtx object created with TSMonitorLGCtxCreate()
7569 
7570    Level: intermediate
7571 
7572    Notes: Each process in a parallel run displays its component errors in a separate window
7573 
7574    The user must provide the solution using TSSetSolutionFunction() to use this monitor.
7575 
7576    Options Database Keys:
7577 .  -ts_monitor_lg_error - create a graphical monitor of error history
7578 
7579 .keywords: TS,  vector, monitor, view
7580 
7581 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSSetSolutionFunction()
7582 @*/
7583 PetscErrorCode  TSMonitorLGError(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dummy)
7584 {
7585   PetscErrorCode    ierr;
7586   TSMonitorLGCtx    ctx = (TSMonitorLGCtx)dummy;
7587   const PetscScalar *yy;
7588   Vec               y;
7589 
7590   PetscFunctionBegin;
7591   if (!step) {
7592     PetscDrawAxis axis;
7593     PetscInt      dim;
7594     ierr = PetscDrawLGGetAxis(ctx->lg,&axis);CHKERRQ(ierr);
7595     ierr = PetscDrawAxisSetLabels(axis,"Error in solution as function of time","Time","Error");CHKERRQ(ierr);
7596     ierr = VecGetLocalSize(u,&dim);CHKERRQ(ierr);
7597     ierr = PetscDrawLGSetDimension(ctx->lg,dim);CHKERRQ(ierr);
7598     ierr = PetscDrawLGReset(ctx->lg);CHKERRQ(ierr);
7599   }
7600   ierr = VecDuplicate(u,&y);CHKERRQ(ierr);
7601   ierr = TSComputeSolutionFunction(ts,ptime,y);CHKERRQ(ierr);
7602   ierr = VecAXPY(y,-1.0,u);CHKERRQ(ierr);
7603   ierr = VecGetArrayRead(y,&yy);CHKERRQ(ierr);
7604 #if defined(PETSC_USE_COMPLEX)
7605   {
7606     PetscReal *yreal;
7607     PetscInt  i,n;
7608     ierr = VecGetLocalSize(y,&n);CHKERRQ(ierr);
7609     ierr = PetscMalloc1(n,&yreal);CHKERRQ(ierr);
7610     for (i=0; i<n; i++) yreal[i] = PetscRealPart(yy[i]);
7611     ierr = PetscDrawLGAddCommonPoint(ctx->lg,ptime,yreal);CHKERRQ(ierr);
7612     ierr = PetscFree(yreal);CHKERRQ(ierr);
7613   }
7614 #else
7615   ierr = PetscDrawLGAddCommonPoint(ctx->lg,ptime,yy);CHKERRQ(ierr);
7616 #endif
7617   ierr = VecRestoreArrayRead(y,&yy);CHKERRQ(ierr);
7618   ierr = VecDestroy(&y);CHKERRQ(ierr);
7619   if (((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason)) {
7620     ierr = PetscDrawLGDraw(ctx->lg);CHKERRQ(ierr);
7621     ierr = PetscDrawLGSave(ctx->lg);CHKERRQ(ierr);
7622   }
7623   PetscFunctionReturn(0);
7624 }
7625 
7626 /*@C
7627    TSMonitorError - Monitors progress of the TS solvers by printing the 2 norm of the error at each timestep
7628 
7629    Collective on TS
7630 
7631    Input Parameters:
7632 +  ts - the TS context
7633 .  step - current time-step
7634 .  ptime - current time
7635 .  u - current solution
7636 -  dctx - unused context
7637 
7638    Level: intermediate
7639 
7640    The user must provide the solution using TSSetSolutionFunction() to use this monitor.
7641 
7642    Options Database Keys:
7643 .  -ts_monitor_error - create a graphical monitor of error history
7644 
7645 .keywords: TS,  vector, monitor, view
7646 
7647 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSSetSolutionFunction()
7648 @*/
7649 PetscErrorCode  TSMonitorError(TS ts,PetscInt step,PetscReal ptime,Vec u,PetscViewerAndFormat *vf)
7650 {
7651   PetscErrorCode    ierr;
7652   Vec               y;
7653   PetscReal         nrm;
7654   PetscBool         flg;
7655 
7656   PetscFunctionBegin;
7657   ierr = VecDuplicate(u,&y);CHKERRQ(ierr);
7658   ierr = TSComputeSolutionFunction(ts,ptime,y);CHKERRQ(ierr);
7659   ierr = VecAXPY(y,-1.0,u);CHKERRQ(ierr);
7660   ierr = PetscObjectTypeCompare((PetscObject)vf->viewer,PETSCVIEWERASCII,&flg);CHKERRQ(ierr);
7661   if (flg) {
7662     ierr = VecNorm(y,NORM_2,&nrm);CHKERRQ(ierr);
7663     ierr = PetscViewerASCIIPrintf(vf->viewer,"2-norm of error %g\n",(double)nrm);CHKERRQ(ierr);
7664   }
7665   ierr = PetscObjectTypeCompare((PetscObject)vf->viewer,PETSCVIEWERDRAW,&flg);CHKERRQ(ierr);
7666   if (flg) {
7667     ierr = VecView(y,vf->viewer);CHKERRQ(ierr);
7668   }
7669   ierr = VecDestroy(&y);CHKERRQ(ierr);
7670   PetscFunctionReturn(0);
7671 }
7672 
7673 PetscErrorCode TSMonitorLGSNESIterations(TS ts,PetscInt n,PetscReal ptime,Vec v,void *monctx)
7674 {
7675   TSMonitorLGCtx ctx = (TSMonitorLGCtx) monctx;
7676   PetscReal      x   = ptime,y;
7677   PetscErrorCode ierr;
7678   PetscInt       its;
7679 
7680   PetscFunctionBegin;
7681   if (n < 0) PetscFunctionReturn(0); /* -1 indicates interpolated solution */
7682   if (!n) {
7683     PetscDrawAxis axis;
7684     ierr = PetscDrawLGGetAxis(ctx->lg,&axis);CHKERRQ(ierr);
7685     ierr = PetscDrawAxisSetLabels(axis,"Nonlinear iterations as function of time","Time","SNES Iterations");CHKERRQ(ierr);
7686     ierr = PetscDrawLGReset(ctx->lg);CHKERRQ(ierr);
7687     ctx->snes_its = 0;
7688   }
7689   ierr = TSGetSNESIterations(ts,&its);CHKERRQ(ierr);
7690   y    = its - ctx->snes_its;
7691   ierr = PetscDrawLGAddPoint(ctx->lg,&x,&y);CHKERRQ(ierr);
7692   if (((ctx->howoften > 0) && (!(n % ctx->howoften)) && (n > -1)) || ((ctx->howoften == -1) && (n == -1))) {
7693     ierr = PetscDrawLGDraw(ctx->lg);CHKERRQ(ierr);
7694     ierr = PetscDrawLGSave(ctx->lg);CHKERRQ(ierr);
7695   }
7696   ctx->snes_its = its;
7697   PetscFunctionReturn(0);
7698 }
7699 
7700 PetscErrorCode TSMonitorLGKSPIterations(TS ts,PetscInt n,PetscReal ptime,Vec v,void *monctx)
7701 {
7702   TSMonitorLGCtx ctx = (TSMonitorLGCtx) monctx;
7703   PetscReal      x   = ptime,y;
7704   PetscErrorCode ierr;
7705   PetscInt       its;
7706 
7707   PetscFunctionBegin;
7708   if (n < 0) PetscFunctionReturn(0); /* -1 indicates interpolated solution */
7709   if (!n) {
7710     PetscDrawAxis axis;
7711     ierr = PetscDrawLGGetAxis(ctx->lg,&axis);CHKERRQ(ierr);
7712     ierr = PetscDrawAxisSetLabels(axis,"Linear iterations as function of time","Time","KSP Iterations");CHKERRQ(ierr);
7713     ierr = PetscDrawLGReset(ctx->lg);CHKERRQ(ierr);
7714     ctx->ksp_its = 0;
7715   }
7716   ierr = TSGetKSPIterations(ts,&its);CHKERRQ(ierr);
7717   y    = its - ctx->ksp_its;
7718   ierr = PetscDrawLGAddPoint(ctx->lg,&x,&y);CHKERRQ(ierr);
7719   if (((ctx->howoften > 0) && (!(n % ctx->howoften)) && (n > -1)) || ((ctx->howoften == -1) && (n == -1))) {
7720     ierr = PetscDrawLGDraw(ctx->lg);CHKERRQ(ierr);
7721     ierr = PetscDrawLGSave(ctx->lg);CHKERRQ(ierr);
7722   }
7723   ctx->ksp_its = its;
7724   PetscFunctionReturn(0);
7725 }
7726 
7727 /*@
7728    TSComputeLinearStability - computes the linear stability function at a point
7729 
7730    Collective on TS and Vec
7731 
7732    Input Parameters:
7733 +  ts - the TS context
7734 -  xr,xi - real and imaginary part of input arguments
7735 
7736    Output Parameters:
7737 .  yr,yi - real and imaginary part of function value
7738 
7739    Level: developer
7740 
7741 .keywords: TS, compute
7742 
7743 .seealso: TSSetRHSFunction(), TSComputeIFunction()
7744 @*/
7745 PetscErrorCode TSComputeLinearStability(TS ts,PetscReal xr,PetscReal xi,PetscReal *yr,PetscReal *yi)
7746 {
7747   PetscErrorCode ierr;
7748 
7749   PetscFunctionBegin;
7750   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
7751   if (!ts->ops->linearstability) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Linearized stability function not provided for this method");
7752   ierr = (*ts->ops->linearstability)(ts,xr,xi,yr,yi);CHKERRQ(ierr);
7753   PetscFunctionReturn(0);
7754 }
7755 
7756 /* ------------------------------------------------------------------------*/
7757 /*@C
7758    TSMonitorEnvelopeCtxCreate - Creates a context for use with TSMonitorEnvelope()
7759 
7760    Collective on TS
7761 
7762    Input Parameters:
7763 .  ts  - the ODE solver object
7764 
7765    Output Parameter:
7766 .  ctx - the context
7767 
7768    Level: intermediate
7769 
7770 .keywords: TS, monitor, line graph, residual, seealso
7771 
7772 .seealso: TSMonitorLGTimeStep(), TSMonitorSet(), TSMonitorLGSolution(), TSMonitorLGError()
7773 
7774 @*/
7775 PetscErrorCode  TSMonitorEnvelopeCtxCreate(TS ts,TSMonitorEnvelopeCtx *ctx)
7776 {
7777   PetscErrorCode ierr;
7778 
7779   PetscFunctionBegin;
7780   ierr = PetscNew(ctx);CHKERRQ(ierr);
7781   PetscFunctionReturn(0);
7782 }
7783 
7784 /*@C
7785    TSMonitorEnvelope - Monitors the maximum and minimum value of each component of the solution
7786 
7787    Collective on TS
7788 
7789    Input Parameters:
7790 +  ts - the TS context
7791 .  step - current time-step
7792 .  ptime - current time
7793 .  u  - current solution
7794 -  dctx - the envelope context
7795 
7796    Options Database:
7797 .  -ts_monitor_envelope
7798 
7799    Level: intermediate
7800 
7801    Notes: after a solve you can use TSMonitorEnvelopeGetBounds() to access the envelope
7802 
7803 .keywords: TS,  vector, monitor, view
7804 
7805 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorEnvelopeGetBounds(), TSMonitorEnvelopeCtxCreate()
7806 @*/
7807 PetscErrorCode  TSMonitorEnvelope(TS ts,PetscInt step,PetscReal ptime,Vec u,void *dctx)
7808 {
7809   PetscErrorCode       ierr;
7810   TSMonitorEnvelopeCtx ctx = (TSMonitorEnvelopeCtx)dctx;
7811 
7812   PetscFunctionBegin;
7813   if (!ctx->max) {
7814     ierr = VecDuplicate(u,&ctx->max);CHKERRQ(ierr);
7815     ierr = VecDuplicate(u,&ctx->min);CHKERRQ(ierr);
7816     ierr = VecCopy(u,ctx->max);CHKERRQ(ierr);
7817     ierr = VecCopy(u,ctx->min);CHKERRQ(ierr);
7818   } else {
7819     ierr = VecPointwiseMax(ctx->max,u,ctx->max);CHKERRQ(ierr);
7820     ierr = VecPointwiseMin(ctx->min,u,ctx->min);CHKERRQ(ierr);
7821   }
7822   PetscFunctionReturn(0);
7823 }
7824 
7825 /*@C
7826    TSMonitorEnvelopeGetBounds - Gets the bounds for the components of the solution
7827 
7828    Collective on TS
7829 
7830    Input Parameter:
7831 .  ts - the TS context
7832 
7833    Output Parameter:
7834 +  max - the maximum values
7835 -  min - the minimum values
7836 
7837    Notes: If the TS does not have a TSMonitorEnvelopeCtx associated with it then this function is ignored
7838 
7839    Level: intermediate
7840 
7841 .keywords: TS,  vector, monitor, view
7842 
7843 .seealso: TSMonitorSet(), TSMonitorDefault(), VecView(), TSMonitorLGSetDisplayVariables()
7844 @*/
7845 PetscErrorCode  TSMonitorEnvelopeGetBounds(TS ts,Vec *max,Vec *min)
7846 {
7847   PetscInt i;
7848 
7849   PetscFunctionBegin;
7850   if (max) *max = NULL;
7851   if (min) *min = NULL;
7852   for (i=0; i<ts->numbermonitors; i++) {
7853     if (ts->monitor[i] == TSMonitorEnvelope) {
7854       TSMonitorEnvelopeCtx  ctx = (TSMonitorEnvelopeCtx) ts->monitorcontext[i];
7855       if (max) *max = ctx->max;
7856       if (min) *min = ctx->min;
7857       break;
7858     }
7859   }
7860   PetscFunctionReturn(0);
7861 }
7862 
7863 /*@C
7864    TSMonitorEnvelopeCtxDestroy - Destroys a context that was created  with TSMonitorEnvelopeCtxCreate().
7865 
7866    Collective on TSMonitorEnvelopeCtx
7867 
7868    Input Parameter:
7869 .  ctx - the monitor context
7870 
7871    Level: intermediate
7872 
7873 .keywords: TS, monitor, line graph, destroy
7874 
7875 .seealso: TSMonitorLGCtxCreate(),  TSMonitorSet(), TSMonitorLGTimeStep()
7876 @*/
7877 PetscErrorCode  TSMonitorEnvelopeCtxDestroy(TSMonitorEnvelopeCtx *ctx)
7878 {
7879   PetscErrorCode ierr;
7880 
7881   PetscFunctionBegin;
7882   ierr = VecDestroy(&(*ctx)->min);CHKERRQ(ierr);
7883   ierr = VecDestroy(&(*ctx)->max);CHKERRQ(ierr);
7884   ierr = PetscFree(*ctx);CHKERRQ(ierr);
7885   PetscFunctionReturn(0);
7886 }
7887 
7888 /*@
7889    TSRestartStep - Flags the solver to restart the next step
7890 
7891    Collective on TS
7892 
7893    Input Parameter:
7894 .  ts - the TS context obtained from TSCreate()
7895 
7896    Level: advanced
7897 
7898    Notes:
7899    Multistep methods like BDF or Runge-Kutta methods with FSAL property require restarting the solver in the event of
7900    discontinuities. These discontinuities may be introduced as a consequence of explicitly modifications to the solution
7901    vector (which PETSc attempts to detect and handle) or problem coefficients (which PETSc is not able to detect). For
7902    the sake of correctness and maximum safety, users are expected to call TSRestart() whenever they introduce
7903    discontinuities in callback routines (e.g. prestep and poststep routines, or implicit/rhs function routines with
7904    discontinuous source terms).
7905 
7906 .keywords: TS, timestep, restart
7907 
7908 .seealso: TSSolve(), TSSetPreStep(), TSSetPostStep()
7909 @*/
7910 PetscErrorCode TSRestartStep(TS ts)
7911 {
7912   PetscFunctionBegin;
7913   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
7914   ts->steprestart = PETSC_TRUE;
7915   PetscFunctionReturn(0);
7916 }
7917 
7918 /*@
7919    TSRollBack - Rolls back one time step
7920 
7921    Collective on TS
7922 
7923    Input Parameter:
7924 .  ts - the TS context obtained from TSCreate()
7925 
7926    Level: advanced
7927 
7928 .keywords: TS, timestep, rollback
7929 
7930 .seealso: TSCreate(), TSSetUp(), TSDestroy(), TSSolve(), TSSetPreStep(), TSSetPreStage(), TSInterpolate()
7931 @*/
7932 PetscErrorCode  TSRollBack(TS ts)
7933 {
7934   PetscErrorCode ierr;
7935 
7936   PetscFunctionBegin;
7937   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
7938   if (ts->steprollback) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_WRONGSTATE,"TSRollBack already called");
7939   if (!ts->ops->rollback) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSRollBack not implemented for type '%s'",((PetscObject)ts)->type_name);
7940   ierr = (*ts->ops->rollback)(ts);CHKERRQ(ierr);
7941   ts->time_step = ts->ptime - ts->ptime_prev;
7942   ts->ptime = ts->ptime_prev;
7943   ts->ptime_prev = ts->ptime_prev_rollback;
7944   ts->steps--;
7945   ts->steprollback = PETSC_TRUE;
7946   PetscFunctionReturn(0);
7947 }
7948 
7949 /*@
7950    TSGetStages - Get the number of stages and stage values
7951 
7952    Input Parameter:
7953 .  ts - the TS context obtained from TSCreate()
7954 
7955    Level: advanced
7956 
7957 .keywords: TS, getstages
7958 
7959 .seealso: TSCreate()
7960 @*/
7961 PetscErrorCode  TSGetStages(TS ts,PetscInt *ns,Vec **Y)
7962 {
7963   PetscErrorCode ierr;
7964 
7965   PetscFunctionBegin;
7966   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
7967   PetscValidPointer(ns,2);
7968 
7969   if (!ts->ops->getstages) *ns=0;
7970   else {
7971     ierr = (*ts->ops->getstages)(ts,ns,Y);CHKERRQ(ierr);
7972   }
7973   PetscFunctionReturn(0);
7974 }
7975 
7976 /*@C
7977   TSComputeIJacobianDefaultColor - Computes the Jacobian using finite differences and coloring to exploit matrix sparsity.
7978 
7979   Collective on SNES
7980 
7981   Input Parameters:
7982 + ts - the TS context
7983 . t - current timestep
7984 . U - state vector
7985 . Udot - time derivative of state vector
7986 . shift - shift to apply, see note below
7987 - ctx - an optional user context
7988 
7989   Output Parameters:
7990 + J - Jacobian matrix (not altered in this routine)
7991 - B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
7992 
7993   Level: intermediate
7994 
7995   Notes:
7996   If F(t,U,Udot)=0 is the DAE, the required Jacobian is
7997 
7998   dF/dU + shift*dF/dUdot
7999 
8000   Most users should not need to explicitly call this routine, as it
8001   is used internally within the nonlinear solvers.
8002 
8003   This will first try to get the coloring from the DM.  If the DM type has no coloring
8004   routine, then it will try to get the coloring from the matrix.  This requires that the
8005   matrix have nonzero entries precomputed.
8006 
8007 .keywords: TS, finite differences, Jacobian, coloring, sparse
8008 .seealso: TSSetIJacobian(), MatFDColoringCreate(), MatFDColoringSetFunction()
8009 @*/
8010 PetscErrorCode TSComputeIJacobianDefaultColor(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal shift,Mat J,Mat B,void *ctx)
8011 {
8012   SNES           snes;
8013   MatFDColoring  color;
8014   PetscBool      hascolor, matcolor = PETSC_FALSE;
8015   PetscErrorCode ierr;
8016 
8017   PetscFunctionBegin;
8018   ierr = PetscOptionsGetBool(((PetscObject)ts)->options,((PetscObject) ts)->prefix, "-ts_fd_color_use_mat", &matcolor, NULL);CHKERRQ(ierr);
8019   ierr = PetscObjectQuery((PetscObject) B, "TSMatFDColoring", (PetscObject *) &color);CHKERRQ(ierr);
8020   if (!color) {
8021     DM         dm;
8022     ISColoring iscoloring;
8023 
8024     ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
8025     ierr = DMHasColoring(dm, &hascolor);CHKERRQ(ierr);
8026     if (hascolor && !matcolor) {
8027       ierr = DMCreateColoring(dm, IS_COLORING_GLOBAL, &iscoloring);CHKERRQ(ierr);
8028       ierr = MatFDColoringCreate(B, iscoloring, &color);CHKERRQ(ierr);
8029       ierr = MatFDColoringSetFunction(color, (PetscErrorCode (*)(void)) SNESTSFormFunction, (void *) ts);CHKERRQ(ierr);
8030       ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
8031       ierr = MatFDColoringSetUp(B, iscoloring, color);CHKERRQ(ierr);
8032       ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
8033     } else {
8034       MatColoring mc;
8035 
8036       ierr = MatColoringCreate(B, &mc);CHKERRQ(ierr);
8037       ierr = MatColoringSetDistance(mc, 2);CHKERRQ(ierr);
8038       ierr = MatColoringSetType(mc, MATCOLORINGSL);CHKERRQ(ierr);
8039       ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
8040       ierr = MatColoringApply(mc, &iscoloring);CHKERRQ(ierr);
8041       ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
8042       ierr = MatFDColoringCreate(B, iscoloring, &color);CHKERRQ(ierr);
8043       ierr = MatFDColoringSetFunction(color, (PetscErrorCode (*)(void)) SNESTSFormFunction, (void *) ts);CHKERRQ(ierr);
8044       ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
8045       ierr = MatFDColoringSetUp(B, iscoloring, color);CHKERRQ(ierr);
8046       ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
8047     }
8048     ierr = PetscObjectCompose((PetscObject) B, "TSMatFDColoring", (PetscObject) color);CHKERRQ(ierr);
8049     ierr = PetscObjectDereference((PetscObject) color);CHKERRQ(ierr);
8050   }
8051   ierr = TSGetSNES(ts, &snes);CHKERRQ(ierr);
8052   ierr = MatFDColoringApply(B, color, U, snes);CHKERRQ(ierr);
8053   if (J != B) {
8054     ierr = MatAssemblyBegin(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8055     ierr = MatAssemblyEnd(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8056   }
8057   PetscFunctionReturn(0);
8058 }
8059 
8060 /*@
8061     TSSetFunctionDomainError - Set the function testing if the current state vector is valid
8062 
8063     Input Parameters:
8064     ts - the TS context
8065     func - function called within TSFunctionDomainError
8066 
8067     Level: intermediate
8068 
8069 .keywords: TS, state, domain
8070 .seealso: TSAdaptCheckStage(), TSFunctionDomainError()
8071 @*/
8072 
8073 PetscErrorCode TSSetFunctionDomainError(TS ts, PetscErrorCode (*func)(TS,PetscReal,Vec,PetscBool*))
8074 {
8075   PetscFunctionBegin;
8076   PetscValidHeaderSpecific(ts, TS_CLASSID,1);
8077   ts->functiondomainerror = func;
8078   PetscFunctionReturn(0);
8079 }
8080 
8081 /*@
8082     TSFunctionDomainError - Check if the current state is valid
8083 
8084     Input Parameters:
8085     ts - the TS context
8086     stagetime - time of the simulation
8087     Y - state vector to check.
8088 
8089     Output Parameter:
8090     accept - Set to PETSC_FALSE if the current state vector is valid.
8091 
8092     Note:
8093     This function should be used to ensure the state is in a valid part of the space.
8094     For example, one can ensure here all values are positive.
8095 
8096     Level: advanced
8097 @*/
8098 PetscErrorCode TSFunctionDomainError(TS ts,PetscReal stagetime,Vec Y,PetscBool* accept)
8099 {
8100   PetscErrorCode ierr;
8101 
8102   PetscFunctionBegin;
8103 
8104   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
8105   *accept = PETSC_TRUE;
8106   if (ts->functiondomainerror) {
8107     PetscStackCallStandard((*ts->functiondomainerror),(ts,stagetime,Y,accept));
8108   }
8109   PetscFunctionReturn(0);
8110 }
8111 
8112 /*@C
8113   TSClone - This function clones a time step object.
8114 
8115   Collective on MPI_Comm
8116 
8117   Input Parameter:
8118 . tsin    - The input TS
8119 
8120   Output Parameter:
8121 . tsout   - The output TS (cloned)
8122 
8123   Notes:
8124   This function is used to create a clone of a TS object. It is used in ARKIMEX for initializing the slope for first stage explicit methods. It will likely be replaced in the future with a mechanism of switching methods on the fly.
8125 
8126   When using TSDestroy() on a clone the user has to first reset the correct TS reference in the embedded SNES object: e.g.: by running SNES snes_dup=NULL; TSGetSNES(ts,&snes_dup); ierr = TSSetSNES(ts,snes_dup);
8127 
8128   Level: developer
8129 
8130 .keywords: TS, clone
8131 .seealso: TSCreate(), TSSetType(), TSSetUp(), TSDestroy(), TSSetProblemType()
8132 @*/
8133 PetscErrorCode  TSClone(TS tsin, TS *tsout)
8134 {
8135   TS             t;
8136   PetscErrorCode ierr;
8137   SNES           snes_start;
8138   DM             dm;
8139   TSType         type;
8140 
8141   PetscFunctionBegin;
8142   PetscValidPointer(tsin,1);
8143   *tsout = NULL;
8144 
8145   ierr = PetscHeaderCreate(t, TS_CLASSID, "TS", "Time stepping", "TS", PetscObjectComm((PetscObject)tsin), TSDestroy, TSView);CHKERRQ(ierr);
8146 
8147   /* General TS description */
8148   t->numbermonitors    = 0;
8149   t->setupcalled       = 0;
8150   t->ksp_its           = 0;
8151   t->snes_its          = 0;
8152   t->nwork             = 0;
8153   t->rhsjacobian.time  = -1e20;
8154   t->rhsjacobian.scale = 1.;
8155   t->ijacobian.shift   = 1.;
8156 
8157   ierr = TSGetSNES(tsin,&snes_start);CHKERRQ(ierr);
8158   ierr = TSSetSNES(t,snes_start);CHKERRQ(ierr);
8159 
8160   ierr = TSGetDM(tsin,&dm);CHKERRQ(ierr);
8161   ierr = TSSetDM(t,dm);CHKERRQ(ierr);
8162 
8163   t->adapt = tsin->adapt;
8164   ierr = PetscObjectReference((PetscObject)t->adapt);CHKERRQ(ierr);
8165 
8166   t->trajectory = tsin->trajectory;
8167   ierr = PetscObjectReference((PetscObject)t->trajectory);CHKERRQ(ierr);
8168 
8169   t->event = tsin->event;
8170   if (t->event) t->event->refct++;
8171 
8172   t->problem_type      = tsin->problem_type;
8173   t->ptime             = tsin->ptime;
8174   t->ptime_prev        = tsin->ptime_prev;
8175   t->time_step         = tsin->time_step;
8176   t->max_time          = tsin->max_time;
8177   t->steps             = tsin->steps;
8178   t->max_steps         = tsin->max_steps;
8179   t->equation_type     = tsin->equation_type;
8180   t->atol              = tsin->atol;
8181   t->rtol              = tsin->rtol;
8182   t->max_snes_failures = tsin->max_snes_failures;
8183   t->max_reject        = tsin->max_reject;
8184   t->errorifstepfailed = tsin->errorifstepfailed;
8185 
8186   ierr = TSGetType(tsin,&type);CHKERRQ(ierr);
8187   ierr = TSSetType(t,type);CHKERRQ(ierr);
8188 
8189   t->vec_sol           = NULL;
8190 
8191   t->cfltime          = tsin->cfltime;
8192   t->cfltime_local    = tsin->cfltime_local;
8193   t->exact_final_time = tsin->exact_final_time;
8194 
8195   ierr = PetscMemcpy(t->ops,tsin->ops,sizeof(struct _TSOps));CHKERRQ(ierr);
8196 
8197   if (((PetscObject)tsin)->fortran_func_pointers) {
8198     PetscInt i;
8199     ierr = PetscMalloc((10)*sizeof(void(*)(void)),&((PetscObject)t)->fortran_func_pointers);CHKERRQ(ierr);
8200     for (i=0; i<10; i++) {
8201       ((PetscObject)t)->fortran_func_pointers[i] = ((PetscObject)tsin)->fortran_func_pointers[i];
8202     }
8203   }
8204   *tsout = t;
8205   PetscFunctionReturn(0);
8206 }
8207 
8208 static PetscErrorCode RHSWrapperFunction_TSRHSJacobianTest(void* ctx,Vec x,Vec y)
8209 {
8210   PetscErrorCode ierr;
8211   TS             ts = (TS) ctx;
8212 
8213   PetscFunctionBegin;
8214   ierr = TSComputeRHSFunction(ts,0,x,y);CHKERRQ(ierr);
8215   PetscFunctionReturn(0);
8216 }
8217 
8218 /*@
8219     TSRHSJacobianTest - Compares the multiply routine provided to the MATSHELL with differencing on the TS given RHS function.
8220 
8221    Logically Collective on TS and Mat
8222 
8223     Input Parameters:
8224     TS - the time stepping routine
8225 
8226    Output Parameter:
8227 .   flg - PETSC_TRUE if the multiply is likely correct
8228 
8229    Options Database:
8230  .   -ts_rhs_jacobian_test_mult -mat_shell_test_mult_view - run the test at each timestep of the integrator
8231 
8232    Level: advanced
8233 
8234    Notes: This only works for problems defined only the RHS function and Jacobian NOT IFunction and IJacobian
8235 
8236 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellTestMultTranspose(), TSRHSJacobianTestTranspose()
8237 @*/
8238 PetscErrorCode  TSRHSJacobianTest(TS ts,PetscBool *flg)
8239 {
8240   Mat            J,B;
8241   PetscErrorCode ierr;
8242   TSRHSJacobian  func;
8243   void*          ctx;
8244 
8245   PetscFunctionBegin;
8246   ierr = TSGetRHSJacobian(ts,&J,&B,&func,&ctx);CHKERRQ(ierr);
8247   ierr = (*func)(ts,0.0,ts->vec_sol,J,B,ctx);CHKERRQ(ierr);
8248   ierr = MatShellTestMult(J,RHSWrapperFunction_TSRHSJacobianTest,ts->vec_sol,ts,flg);CHKERRQ(ierr);
8249   PetscFunctionReturn(0);
8250 }
8251 
8252 /*@C
8253     TSRHSJacobianTestTranspose - Compares the multiply transpose routine provided to the MATSHELL with differencing on the TS given RHS function.
8254 
8255    Logically Collective on TS and Mat
8256 
8257     Input Parameters:
8258     TS - the time stepping routine
8259 
8260    Output Parameter:
8261 .   flg - PETSC_TRUE if the multiply is likely correct
8262 
8263    Options Database:
8264 .   -ts_rhs_jacobian_test_mult_transpose -mat_shell_test_mult_transpose_view - run the test at each timestep of the integrator
8265 
8266    Notes: This only works for problems defined only the RHS function and Jacobian NOT IFunction and IJacobian
8267 
8268    Level: advanced
8269 
8270 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellTestMultTranspose(), TSRHSJacobianTest()
8271 @*/
8272 PetscErrorCode  TSRHSJacobianTestTranspose(TS ts,PetscBool *flg)
8273 {
8274   Mat            J,B;
8275   PetscErrorCode ierr;
8276   void           *ctx;
8277   TSRHSJacobian  func;
8278 
8279   PetscFunctionBegin;
8280   ierr = TSGetRHSJacobian(ts,&J,&B,&func,&ctx);CHKERRQ(ierr);
8281   ierr = (*func)(ts,0.0,ts->vec_sol,J,B,ctx);CHKERRQ(ierr);
8282   ierr = MatShellTestMultTranspose(J,RHSWrapperFunction_TSRHSJacobianTest,ts->vec_sol,ts,flg);CHKERRQ(ierr);
8283   PetscFunctionReturn(0);
8284 }
8285