xref: /petsc/src/ts/impls/arkimex/arkimex.c (revision 5e71baeff2f3138f93cd4f5927dfd596eb8325cc) !
1 /*
2   Code for timestepping with additive Runge-Kutta IMEX method
3 
4   Notes:
5   The general system is written as
6 
7   F(t,U,Udot) = G(t,U)
8 
9   where F represents the stiff part of the physics and G represents the non-stiff part.
10 
11 */
12 #include <petsc/private/tsimpl.h>                /*I   "petscts.h"   I*/
13 #include <petscdm.h>
14 
15 static TSARKIMEXType  TSARKIMEXDefault = TSARKIMEX3;
16 static PetscBool      TSARKIMEXRegisterAllCalled;
17 static PetscBool      TSARKIMEXPackageInitialized;
18 static PetscErrorCode TSExtrapolate_ARKIMEX(TS,PetscReal,Vec);
19 
20 typedef struct _ARKTableau *ARKTableau;
21 struct _ARKTableau {
22   char      *name;
23   PetscInt  order;                /* Classical approximation order of the method */
24   PetscInt  s;                    /* Number of stages */
25   PetscBool stiffly_accurate;     /* The implicit part is stiffly accurate*/
26   PetscBool FSAL_implicit;        /* The implicit part is FSAL*/
27   PetscBool explicit_first_stage; /* The implicit part has an explicit first stage*/
28   PetscInt  pinterp;              /* Interpolation order */
29   PetscReal *At,*bt,*ct;          /* Stiff tableau */
30   PetscReal *A,*b,*c;             /* Non-stiff tableau */
31   PetscReal *bembedt,*bembed;     /* Embedded formula of order one less (order-1) */
32   PetscReal *binterpt,*binterp;   /* Dense output formula */
33   PetscReal ccfl;                 /* Placeholder for CFL coefficient relative to forward Euler */
34 };
35 typedef struct _ARKTableauLink *ARKTableauLink;
36 struct _ARKTableauLink {
37   struct _ARKTableau tab;
38   ARKTableauLink     next;
39 };
40 static ARKTableauLink ARKTableauList;
41 
42 typedef struct {
43   ARKTableau   tableau;
44   Vec          *Y;               /* States computed during the step */
45   Vec          *YdotI;           /* Time derivatives for the stiff part */
46   Vec          *YdotRHS;         /* Function evaluations for the non-stiff part */
47   Vec          *Y_prev;          /* States computed during the previous time step */
48   Vec          *YdotI_prev;      /* Time derivatives for the stiff part for the previous time step*/
49   Vec          *YdotRHS_prev;    /* Function evaluations for the non-stiff part for the previous time step*/
50   Vec          Ydot0;            /* Holds the slope from the previous step in FSAL case */
51   Vec          Ydot;             /* Work vector holding Ydot during residual evaluation */
52   Vec          Z;                /* Ydot = shift(Y-Z) */
53   PetscScalar  *work;            /* Scalar work */
54   PetscReal    scoeff;           /* shift = scoeff/dt */
55   PetscReal    stage_time;
56   PetscBool    imex;
57   PetscBool    extrapolate;      /* Extrapolate initial guess from previous time-step stage values */
58   TSStepStatus status;
59 } TS_ARKIMEX;
60 /*MC
61      TSARKIMEXARS122 - Second order ARK IMEX scheme.
62 
63      This method has one explicit stage and one implicit stage.
64 
65      Options Database:
66 .      -ts_arkimex_type ars122
67 
68      References:
69 .   1. -  U. Ascher, S. Ruuth, R. J. Spiteri, Implicit explicit Runge Kutta methods for time dependent Partial Differential Equations. Appl. Numer. Math. 25, (1997).
70 
71      Level: advanced
72 
73 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
74 M*/
75 /*MC
76      TSARKIMEXA2 - Second order ARK IMEX scheme with A-stable implicit part.
77 
78      This method has an explicit stage and one implicit stage, and has an A-stable implicit scheme. This method was provided by Emil Constantinescu.
79 
80      Options Database:
81 .      -ts_arkimex_type a2
82 
83      Level: advanced
84 
85 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
86 M*/
87 /*MC
88      TSARKIMEXL2 - Second order ARK IMEX scheme with L-stable implicit part.
89 
90      This method has two implicit stages, and L-stable implicit scheme.
91 
92      Options Database:
93 .      -ts_arkimex_type l2
94 
95     References:
96 .   1. -  L. Pareschi, G. Russo, Implicit Explicit Runge Kutta schemes and applications to hyperbolic systems with relaxations. Journal of Scientific Computing Volume: 25, Issue: 1, October, 2005.
97 
98      Level: advanced
99 
100 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
101 M*/
102 /*MC
103      TSARKIMEX1BEE - First order Backward Euler represented as an ARK IMEX scheme with extrapolation as error estimator. This is a 3-stage method.
104 
105      This method is aimed at starting the integration of implicit DAEs when explicit first-stage ARK methods are used.
106 
107      Options Database:
108 .      -ts_arkimex_type 1bee
109 
110      Level: advanced
111 
112 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
113 M*/
114 /*MC
115      TSARKIMEX2C - Second order ARK IMEX scheme with L-stable implicit part.
116 
117      This method has one explicit stage and two implicit stages. The implicit part is the same as in TSARKIMEX2D and TSARKIMEX2E, but the explicit part has a larger stability region on the negative real axis. This method was provided by Emil Constantinescu.
118 
119      Options Database:
120 .      -ts_arkimex_type 2c
121 
122      Level: advanced
123 
124 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
125 M*/
126 /*MC
127      TSARKIMEX2D - Second order ARK IMEX scheme with L-stable implicit part.
128 
129      This method has one explicit stage and two implicit stages. The stability function is independent of the explicit part in the infinity limit of the implict component. This method was provided by Emil Constantinescu.
130 
131      Options Database:
132 .      -ts_arkimex_type 2d
133 
134      Level: advanced
135 
136 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
137 M*/
138 /*MC
139      TSARKIMEX2E - Second order ARK IMEX scheme with L-stable implicit part.
140 
141      This method has one explicit stage and two implicit stages. It is is an optimal method developed by Emil Constantinescu.
142 
143      Options Database:
144 .      -ts_arkimex_type 2e
145 
146     Level: advanced
147 
148 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
149 M*/
150 /*MC
151      TSARKIMEXPRSSP2 - Second order SSP ARK IMEX scheme.
152 
153      This method has three implicit stages.
154 
155      References:
156 .   1. -  L. Pareschi, G. Russo, Implicit Explicit Runge Kutta schemes and applications to hyperbolic systems with relaxations. Journal of Scientific Computing Volume: 25, Issue: 1, October, 2005.
157 
158      This method is referred to as SSP2-(3,3,2) in http://arxiv.org/abs/1110.4375
159 
160      Options Database:
161 .      -ts_arkimex_type prssp2
162 
163      Level: advanced
164 
165 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
166 M*/
167 /*MC
168      TSARKIMEX3 - Third order ARK IMEX scheme with L-stable implicit part.
169 
170      This method has one explicit stage and three implicit stages.
171 
172      Options Database:
173 .      -ts_arkimex_type 3
174 
175      References:
176 .   1. -  Kennedy and Carpenter 2003.
177 
178      Level: advanced
179 
180 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
181 M*/
182 /*MC
183      TSARKIMEXARS443 - Third order ARK IMEX scheme.
184 
185      This method has one explicit stage and four implicit stages.
186 
187      Options Database:
188 .      -ts_arkimex_type ars443
189 
190      References:
191 +   1. -  U. Ascher, S. Ruuth, R. J. Spiteri, Implicit explicit Runge Kutta methods for time dependent Partial Differential Equations. Appl. Numer. Math. 25, (1997).
192 -   2. -  This method is referred to as ARS(4,4,3) in http://arxiv.org/abs/1110.4375
193 
194      Level: advanced
195 
196 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
197 M*/
198 /*MC
199      TSARKIMEXBPR3 - Third order ARK IMEX scheme.
200 
201      This method has one explicit stage and four implicit stages.
202 
203      Options Database:
204 .      -ts_arkimex_type bpr3
205 
206      References:
207  .    This method is referred to as ARK3 in http://arxiv.org/abs/1110.4375
208 
209      Level: advanced
210 
211 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
212 M*/
213 /*MC
214      TSARKIMEX4 - Fourth order ARK IMEX scheme with L-stable implicit part.
215 
216      This method has one explicit stage and four implicit stages.
217 
218      Options Database:
219 .      -ts_arkimex_type 4
220 
221      References:
222 .     Kennedy and Carpenter 2003.
223 
224      Level: advanced
225 
226 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
227 M*/
228 /*MC
229      TSARKIMEX5 - Fifth order ARK IMEX scheme with L-stable implicit part.
230 
231      This method has one explicit stage and five implicit stages.
232 
233      Options Database:
234 .      -ts_arkimex_type 5
235 
236      References:
237 .     Kennedy and Carpenter 2003.
238 
239      Level: advanced
240 
241 .seealso: TSARKIMEX, TSARKIMEXType, TSARKIMEXSetType()
242 M*/
243 
244 /*@C
245   TSARKIMEXRegisterAll - Registers all of the additive Runge-Kutta implicit-explicit methods in TSARKIMEX
246 
247   Not Collective, but should be called by all processes which will need the schemes to be registered
248 
249   Level: advanced
250 
251 .keywords: TS, TSARKIMEX, register, all
252 
253 .seealso:  TSARKIMEXRegisterDestroy()
254 @*/
255 PetscErrorCode TSARKIMEXRegisterAll(void)
256 {
257   PetscErrorCode ierr;
258 
259   PetscFunctionBegin;
260   if (TSARKIMEXRegisterAllCalled) PetscFunctionReturn(0);
261   TSARKIMEXRegisterAllCalled = PETSC_TRUE;
262 
263   {
264     const PetscReal
265       A[3][3] = {{0.0,0.0,0.0},
266                  {0.0,0.0,0.0},
267                  {0.0,0.5,0.0}},
268       At[3][3] = {{1.0,0.0,0.0},
269                   {0.0,0.5,0.0},
270                   {0.0,0.5,0.5}},
271       b[3]       = {0.0,0.5,0.5},
272       bembedt[3] = {1.0,0.0,0.0};
273     ierr = TSARKIMEXRegister(TSARKIMEX1BEE,2,3,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr);
274   }
275   {
276     const PetscReal
277       A[2][2] = {{0.0,0.0},
278                  {0.5,0.0}},
279       At[2][2] = {{0.0,0.0},
280                   {0.0,0.5}},
281       b[2]       = {0.0,1.0},
282       bembedt[2] = {0.5,0.5};
283     /* binterpt[2][2] = {{1.0,-1.0},{0.0,1.0}};  second order dense output has poor stability properties and hence it is not currently in use*/
284     ierr = TSARKIMEXRegister(TSARKIMEXARS122,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr);
285   }
286   {
287     const PetscReal
288       A[2][2] = {{0.0,0.0},
289                  {1.0,0.0}},
290       At[2][2] = {{0.0,0.0},
291                   {0.5,0.5}},
292       b[2]       = {0.5,0.5},
293       bembedt[2] = {0.0,1.0};
294     /* binterpt[2][2] = {{1.0,-0.5},{0.0,0.5}}  second order dense output has poor stability properties and hence it is not currently in use*/
295     ierr = TSARKIMEXRegister(TSARKIMEXA2,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr);
296   }
297   {
298     /* const PetscReal us2 = 1.0-1.0/PetscSqrtReal((PetscReal)2.0);    Direct evaluation: 0.2928932188134524755992. Used below to ensure all values are available at compile time   */
299     const PetscReal
300       A[2][2] = {{0.0,0.0},
301                  {1.0,0.0}},
302       At[2][2] = {{0.2928932188134524755992,0.0},
303                   {1.0-2.0*0.2928932188134524755992,0.2928932188134524755992}},
304       b[2]       = {0.5,0.5},
305       bembedt[2] = {0.0,1.0},
306       binterpt[2][2] = {{  (0.2928932188134524755992-1.0)/(2.0*0.2928932188134524755992-1.0),-1/(2.0*(1.0-2.0*0.2928932188134524755992))},
307                         {1-(0.2928932188134524755992-1.0)/(2.0*0.2928932188134524755992-1.0),-1/(2.0*(1.0-2.0*0.2928932188134524755992))}},
308       binterp[2][2] = {{1.0,-0.5},{0.0,0.5}};
309     ierr = TSARKIMEXRegister(TSARKIMEXL2,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,2,binterpt[0],binterp[0]);CHKERRQ(ierr);
310   }
311   {
312     /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0),  Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time   */
313     const PetscReal
314       A[3][3] = {{0,0,0},
315                  {2-1.414213562373095048802,0,0},
316                  {0.5,0.5,0}},
317       At[3][3] = {{0,0,0},
318                   {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0},
319                   {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}},
320       bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)},
321       binterpt[3][2] = {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
322                         {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
323                         {1.0-1.414213562373095048802,1.0/1.414213562373095048802}};
324     ierr = TSARKIMEXRegister(TSARKIMEX2C,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr);
325   }
326   {
327     /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0),  Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time   */
328     const PetscReal
329       A[3][3] = {{0,0,0},
330                  {2-1.414213562373095048802,0,0},
331                  {0.75,0.25,0}},
332       At[3][3] = {{0,0,0},
333                   {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0},
334                   {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}},
335       bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)},
336       binterpt[3][2] =  {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
337                          {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
338                          {1.0-1.414213562373095048802,1.0/1.414213562373095048802}};
339     ierr = TSARKIMEXRegister(TSARKIMEX2D,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr);
340   }
341   {                             /* Optimal for linear implicit part */
342     /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0),  Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time   */
343     const PetscReal
344       A[3][3] = {{0,0,0},
345                  {2-1.414213562373095048802,0,0},
346                  {(3-2*1.414213562373095048802)/6,(3+2*1.414213562373095048802)/6,0}},
347       At[3][3] = {{0,0,0},
348                   {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0},
349                   {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}},
350       bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)},
351       binterpt[3][2] =  {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
352                          {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)},
353                          {1.0-1.414213562373095048802,1.0/1.414213562373095048802}};
354     ierr = TSARKIMEXRegister(TSARKIMEX2E,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr);
355   }
356   {                             /* Optimal for linear implicit part */
357     const PetscReal
358       A[3][3] = {{0,0,0},
359                  {0.5,0,0},
360                  {0.5,0.5,0}},
361       At[3][3] = {{0.25,0,0},
362                   {0,0.25,0},
363                   {1./3,1./3,1./3}};
364     ierr = TSARKIMEXRegister(TSARKIMEXPRSSP2,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
365   }
366   {
367     const PetscReal
368       A[4][4] = {{0,0,0,0},
369                  {1767732205903./2027836641118.,0,0,0},
370                  {5535828885825./10492691773637.,788022342437./10882634858940.,0,0},
371                  {6485989280629./16251701735622.,-4246266847089./9704473918619.,10755448449292./10357097424841.,0}},
372       At[4][4] = {{0,0,0,0},
373                   {1767732205903./4055673282236.,1767732205903./4055673282236.,0,0},
374                   {2746238789719./10658868560708.,-640167445237./6845629431997.,1767732205903./4055673282236.,0},
375                   {1471266399579./7840856788654.,-4482444167858./7529755066697.,11266239266428./11593286722821.,1767732205903./4055673282236.}},
376       bembedt[4]     = {2756255671327./12835298489170.,-10771552573575./22201958757719.,9247589265047./10645013368117.,2193209047091./5459859503100.},
377       binterpt[4][2] = {{4655552711362./22874653954995., -215264564351./13552729205753.},
378                         {-18682724506714./9892148508045.,17870216137069./13817060693119.},
379                         {34259539580243./13192909600954.,-28141676662227./17317692491321.},
380                         {584795268549./6622622206610.,   2508943948391./7218656332882.}};
381     ierr = TSARKIMEXRegister(TSARKIMEX3,3,4,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr);
382   }
383   {
384     const PetscReal
385       A[5][5] = {{0,0,0,0,0},
386                  {1./2,0,0,0,0},
387                  {11./18,1./18,0,0,0},
388                  {5./6,-5./6,.5,0,0},
389                  {1./4,7./4,3./4,-7./4,0}},
390       At[5][5] = {{0,0,0,0,0},
391                   {0,1./2,0,0,0},
392                   {0,1./6,1./2,0,0},
393                   {0,-1./2,1./2,1./2,0},
394                   {0,3./2,-3./2,1./2,1./2}},
395     *bembedt = NULL;
396     ierr = TSARKIMEXRegister(TSARKIMEXARS443,3,5,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,0,NULL,NULL);CHKERRQ(ierr);
397   }
398   {
399     const PetscReal
400       A[5][5] = {{0,0,0,0,0},
401                  {1,0,0,0,0},
402                  {4./9,2./9,0,0,0},
403                  {1./4,0,3./4,0,0},
404                  {1./4,0,3./5,0,0}},
405       At[5][5] = {{0,0,0,0,0},
406                   {.5,.5,0,0,0},
407                   {5./18,-1./9,.5,0,0},
408                   {.5,0,0,.5,0},
409                   {.25,0,.75,-.5,.5}},
410     *bembedt = NULL;
411     ierr = TSARKIMEXRegister(TSARKIMEXBPR3,3,5,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,0,NULL,NULL);CHKERRQ(ierr);
412   }
413   {
414     const PetscReal
415       A[6][6] = {{0,0,0,0,0,0},
416                  {1./2,0,0,0,0,0},
417                  {13861./62500.,6889./62500.,0,0,0,0},
418                  {-116923316275./2393684061468.,-2731218467317./15368042101831.,9408046702089./11113171139209.,0,0,0},
419                  {-451086348788./2902428689909.,-2682348792572./7519795681897.,12662868775082./11960479115383.,3355817975965./11060851509271.,0,0},
420                  {647845179188./3216320057751.,73281519250./8382639484533.,552539513391./3454668386233.,3354512671639./8306763924573.,4040./17871.,0}},
421       At[6][6] = {{0,0,0,0,0,0},
422                   {1./4,1./4,0,0,0,0},
423                   {8611./62500.,-1743./31250.,1./4,0,0,0},
424                   {5012029./34652500.,-654441./2922500.,174375./388108.,1./4,0,0},
425                   {15267082809./155376265600.,-71443401./120774400.,730878875./902184768.,2285395./8070912.,1./4,0},
426                   {82889./524892.,0,15625./83664.,69875./102672.,-2260./8211,1./4}},
427       bembedt[6]     = {4586570599./29645900160.,0,178811875./945068544.,814220225./1159782912.,-3700637./11593932.,61727./225920.},
428       binterpt[6][3] = {{6943876665148./7220017795957.,-54480133./30881146.,6818779379841./7100303317025.},
429                         {0,0,0},
430                         {7640104374378./9702883013639.,-11436875./14766696.,2173542590792./12501825683035.},
431                         {-20649996744609./7521556579894.,174696575./18121608.,-31592104683404./5083833661969.},
432                         {8854892464581./2390941311638.,-12120380./966161.,61146701046299./7138195549469.},
433                         {-11397109935349./6675773540249.,3843./706.,-17219254887155./4939391667607.}};
434     ierr = TSARKIMEXRegister(TSARKIMEX4,4,6,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,3,binterpt[0],NULL);CHKERRQ(ierr);
435   }
436   {
437     const PetscReal
438       A[8][8] = {{0,0,0,0,0,0,0,0},
439                  {41./100,0,0,0,0,0,0,0},
440                  {367902744464./2072280473677.,677623207551./8224143866563.,0,0,0,0,0,0},
441                  {1268023523408./10340822734521.,0,1029933939417./13636558850479.,0,0,0,0,0},
442                  {14463281900351./6315353703477.,0,66114435211212./5879490589093.,-54053170152839./4284798021562.,0,0,0,0},
443                  {14090043504691./34967701212078.,0,15191511035443./11219624916014.,-18461159152457./12425892160975.,-281667163811./9011619295870.,0,0,0},
444                  {19230459214898./13134317526959.,0,21275331358303./2942455364971.,-38145345988419./4862620318723.,-1./8,-1./8,0,0},
445                  {-19977161125411./11928030595625.,0,-40795976796054./6384907823539.,177454434618887./12078138498510.,782672205425./8267701900261.,-69563011059811./9646580694205.,7356628210526./4942186776405.,0}},
446       At[8][8] = {{0,0,0,0,0,0,0,0},
447                   {41./200.,41./200.,0,0,0,0,0,0},
448                   {41./400.,-567603406766./11931857230679.,41./200.,0,0,0,0,0},
449                   {683785636431./9252920307686.,0,-110385047103./1367015193373.,41./200.,0,0,0,0},
450                   {3016520224154./10081342136671.,0,30586259806659./12414158314087.,-22760509404356./11113319521817.,41./200.,0,0,0},
451                   {218866479029./1489978393911.,0,638256894668./5436446318841.,-1179710474555./5321154724896.,-60928119172./8023461067671.,41./200.,0,0},
452                   {1020004230633./5715676835656.,0,25762820946817./25263940353407.,-2161375909145./9755907335909.,-211217309593./5846859502534.,-4269925059573./7827059040749.,41./200,0},
453                   {-872700587467./9133579230613.,0,0,22348218063261./9555858737531.,-1143369518992./8141816002931.,-39379526789629./19018526304540.,32727382324388./42900044865799.,41./200.}},
454       bembedt[8]     = {-975461918565./9796059967033.,0,0,78070527104295./32432590147079.,-548382580838./3424219808633.,-33438840321285./15594753105479.,3629800801594./4656183773603.,4035322873751./18575991585200.},
455       binterpt[8][3] = {{-17674230611817./10670229744614.,  43486358583215./12773830924787., -9257016797708./5021505065439.},
456                         {0,  0, 0                            },
457                         {0,  0, 0                            },
458                         {65168852399939./7868540260826.,  -91478233927265./11067650958493., 26096422576131./11239449250142.},
459                         {15494834004392./5936557850923.,  -79368583304911./10890268929626., 92396832856987./20362823103730.},
460                         {-99329723586156./26959484932159.,  -12239297817655./9152339842473., 30029262896817./10175596800299.},
461                         {-19024464361622./5461577185407.,  115839755401235./10719374521269., -26136350496073./3983972220547.},
462                         {-6511271360970./6095937251113.,  5843115559534./2180450260947., -5289405421727./3760307252460. }};
463     ierr = TSARKIMEXRegister(TSARKIMEX5,5,8,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,3,binterpt[0],NULL);CHKERRQ(ierr);
464   }
465   PetscFunctionReturn(0);
466 }
467 
468 /*@C
469    TSARKIMEXRegisterDestroy - Frees the list of schemes that were registered by TSARKIMEXRegister().
470 
471    Not Collective
472 
473    Level: advanced
474 
475 .keywords: TSARKIMEX, register, destroy
476 .seealso: TSARKIMEXRegister(), TSARKIMEXRegisterAll()
477 @*/
478 PetscErrorCode TSARKIMEXRegisterDestroy(void)
479 {
480   PetscErrorCode ierr;
481   ARKTableauLink link;
482 
483   PetscFunctionBegin;
484   while ((link = ARKTableauList)) {
485     ARKTableau t = &link->tab;
486     ARKTableauList = link->next;
487     ierr = PetscFree6(t->At,t->bt,t->ct,t->A,t->b,t->c);CHKERRQ(ierr);
488     ierr = PetscFree2(t->bembedt,t->bembed);CHKERRQ(ierr);
489     ierr = PetscFree2(t->binterpt,t->binterp);CHKERRQ(ierr);
490     ierr = PetscFree(t->name);CHKERRQ(ierr);
491     ierr = PetscFree(link);CHKERRQ(ierr);
492   }
493   TSARKIMEXRegisterAllCalled = PETSC_FALSE;
494   PetscFunctionReturn(0);
495 }
496 
497 /*@C
498   TSARKIMEXInitializePackage - This function initializes everything in the TSARKIMEX package. It is called
499   from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to TSCreate_ARKIMEX()
500   when using static libraries.
501 
502   Level: developer
503 
504 .keywords: TS, TSARKIMEX, initialize, package
505 .seealso: PetscInitialize()
506 @*/
507 PetscErrorCode TSARKIMEXInitializePackage(void)
508 {
509   PetscErrorCode ierr;
510 
511   PetscFunctionBegin;
512   if (TSARKIMEXPackageInitialized) PetscFunctionReturn(0);
513   TSARKIMEXPackageInitialized = PETSC_TRUE;
514   ierr = TSARKIMEXRegisterAll();CHKERRQ(ierr);
515   ierr = PetscRegisterFinalize(TSARKIMEXFinalizePackage);CHKERRQ(ierr);
516   PetscFunctionReturn(0);
517 }
518 
519 /*@C
520   TSARKIMEXFinalizePackage - This function destroys everything in the TSARKIMEX package. It is
521   called from PetscFinalize().
522 
523   Level: developer
524 
525 .keywords: Petsc, destroy, package
526 .seealso: PetscFinalize()
527 @*/
528 PetscErrorCode TSARKIMEXFinalizePackage(void)
529 {
530   PetscErrorCode ierr;
531 
532   PetscFunctionBegin;
533   TSARKIMEXPackageInitialized = PETSC_FALSE;
534   ierr = TSARKIMEXRegisterDestroy();CHKERRQ(ierr);
535   PetscFunctionReturn(0);
536 }
537 
538 /*@C
539    TSARKIMEXRegister - register an ARK IMEX scheme by providing the entries in the Butcher tableau and optionally embedded approximations and interpolation
540 
541    Not Collective, but the same schemes should be registered on all processes on which they will be used
542 
543    Input Parameters:
544 +  name - identifier for method
545 .  order - approximation order of method
546 .  s - number of stages, this is the dimension of the matrices below
547 .  At - Butcher table of stage coefficients for stiff part (dimension s*s, row-major)
548 .  bt - Butcher table for completing the stiff part of the step (dimension s; NULL to use the last row of At)
549 .  ct - Abscissa of each stiff stage (dimension s, NULL to use row sums of At)
550 .  A - Non-stiff stage coefficients (dimension s*s, row-major)
551 .  b - Non-stiff step completion table (dimension s; NULL to use last row of At)
552 .  c - Non-stiff abscissa (dimension s; NULL to use row sums of A)
553 .  bembedt - Stiff part of completion table for embedded method (dimension s; NULL if not available)
554 .  bembed - Non-stiff part of completion table for embedded method (dimension s; NULL to use bembedt if provided)
555 .  pinterp - Order of the interpolation scheme, equal to the number of columns of binterpt and binterp
556 .  binterpt - Coefficients of the interpolation formula for the stiff part (dimension s*pinterp)
557 -  binterp - Coefficients of the interpolation formula for the non-stiff part (dimension s*pinterp; NULL to reuse binterpt)
558 
559    Notes:
560    Several ARK IMEX methods are provided, this function is only needed to create new methods.
561 
562    Level: advanced
563 
564 .keywords: TS, register
565 
566 .seealso: TSARKIMEX
567 @*/
568 PetscErrorCode TSARKIMEXRegister(TSARKIMEXType name,PetscInt order,PetscInt s,
569                                  const PetscReal At[],const PetscReal bt[],const PetscReal ct[],
570                                  const PetscReal A[],const PetscReal b[],const PetscReal c[],
571                                  const PetscReal bembedt[],const PetscReal bembed[],
572                                  PetscInt pinterp,const PetscReal binterpt[],const PetscReal binterp[])
573 {
574   PetscErrorCode ierr;
575   ARKTableauLink link;
576   ARKTableau     t;
577   PetscInt       i,j;
578 
579   PetscFunctionBegin;
580   ierr     = PetscCalloc1(1,&link);CHKERRQ(ierr);
581   t        = &link->tab;
582   ierr     = PetscStrallocpy(name,&t->name);CHKERRQ(ierr);
583   t->order = order;
584   t->s     = s;
585   ierr     = PetscMalloc6(s*s,&t->At,s,&t->bt,s,&t->ct,s*s,&t->A,s,&t->b,s,&t->c);CHKERRQ(ierr);
586   ierr     = PetscMemcpy(t->At,At,s*s*sizeof(At[0]));CHKERRQ(ierr);
587   ierr     = PetscMemcpy(t->A,A,s*s*sizeof(A[0]));CHKERRQ(ierr);
588   if (bt) { ierr = PetscMemcpy(t->bt,bt,s*sizeof(bt[0]));CHKERRQ(ierr); }
589   else for (i=0; i<s; i++) t->bt[i] = At[(s-1)*s+i];
590   if (b)  { ierr = PetscMemcpy(t->b,b,s*sizeof(b[0]));CHKERRQ(ierr); }
591   else for (i=0; i<s; i++) t->b[i] = t->bt[i];
592   if (ct) { ierr = PetscMemcpy(t->ct,ct,s*sizeof(ct[0]));CHKERRQ(ierr); }
593   else for (i=0; i<s; i++) for (j=0,t->ct[i]=0; j<s; j++) t->ct[i] += At[i*s+j];
594   if (c)  { ierr = PetscMemcpy(t->c,c,s*sizeof(c[0]));CHKERRQ(ierr); }
595   else for (i=0; i<s; i++) for (j=0,t->c[i]=0; j<s; j++) t->c[i] += A[i*s+j];
596   t->stiffly_accurate = PETSC_TRUE;
597   for (i=0; i<s; i++) if (t->At[(s-1)*s+i] != t->bt[i]) t->stiffly_accurate = PETSC_FALSE;
598   t->explicit_first_stage = PETSC_TRUE;
599   for (i=0; i<s; i++) if (t->At[i] != 0.0) t->explicit_first_stage = PETSC_FALSE;
600   /*def of FSAL can be made more precise*/
601   t->FSAL_implicit = (PetscBool)(t->explicit_first_stage && t->stiffly_accurate);
602   if (bembedt) {
603     ierr = PetscMalloc2(s,&t->bembedt,s,&t->bembed);CHKERRQ(ierr);
604     ierr = PetscMemcpy(t->bembedt,bembedt,s*sizeof(bembedt[0]));CHKERRQ(ierr);
605     ierr = PetscMemcpy(t->bembed,bembed ? bembed : bembedt,s*sizeof(bembed[0]));CHKERRQ(ierr);
606   }
607 
608   t->pinterp     = pinterp;
609   ierr           = PetscMalloc2(s*pinterp,&t->binterpt,s*pinterp,&t->binterp);CHKERRQ(ierr);
610   ierr           = PetscMemcpy(t->binterpt,binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr);
611   ierr           = PetscMemcpy(t->binterp,binterp ? binterp : binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr);
612   link->next     = ARKTableauList;
613   ARKTableauList = link;
614   PetscFunctionReturn(0);
615 }
616 
617 /*
618  The step completion formula is
619 
620  x1 = x0 - h bt^T YdotI + h b^T YdotRHS
621 
622  This function can be called before or after ts->vec_sol has been updated.
623  Suppose we have a completion formula (bt,b) and an embedded formula (bet,be) of different order.
624  We can write
625 
626  x1e = x0 - h bet^T YdotI + h be^T YdotRHS
627      = x1 + h bt^T YdotI - h b^T YdotRHS - h bet^T YdotI + h be^T YdotRHS
628      = x1 - h (bet - bt)^T YdotI + h (be - b)^T YdotRHS
629 
630  so we can evaluate the method with different order even after the step has been optimistically completed.
631 */
632 static PetscErrorCode TSEvaluateStep_ARKIMEX(TS ts,PetscInt order,Vec X,PetscBool *done)
633 {
634   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
635   ARKTableau     tab  = ark->tableau;
636   PetscScalar    *w   = ark->work;
637   PetscReal      h;
638   PetscInt       s = tab->s,j;
639   PetscErrorCode ierr;
640 
641   PetscFunctionBegin;
642   switch (ark->status) {
643   case TS_STEP_INCOMPLETE:
644   case TS_STEP_PENDING:
645     h = ts->time_step; break;
646   case TS_STEP_COMPLETE:
647     h = ts->ptime - ts->ptime_prev; break;
648   default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus");
649   }
650   if (order == tab->order) {
651     if (ark->status == TS_STEP_INCOMPLETE) {
652       if (!ark->imex && tab->stiffly_accurate) { /* Only the stiffly accurate implicit formula is used */
653         ierr = VecCopy(ark->Y[s-1],X);CHKERRQ(ierr);
654       } else { /* Use the standard completion formula (bt,b) */
655         ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);
656         for (j=0; j<s; j++) w[j] = h*tab->bt[j];
657         ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr);
658         if (ark->imex) { /* Method is IMEX, complete the explicit formula */
659           for (j=0; j<s; j++) w[j] = h*tab->b[j];
660           ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr);
661         }
662       }
663     } else {ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);}
664     if (done) *done = PETSC_TRUE;
665     PetscFunctionReturn(0);
666   } else if (order == tab->order-1) {
667     if (!tab->bembedt) goto unavailable;
668     if (ark->status == TS_STEP_INCOMPLETE) { /* Complete with the embedded method (bet,be) */
669       ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);
670       for (j=0; j<s; j++) w[j] = h*tab->bembedt[j];
671       ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr);
672       for (j=0; j<s; j++) w[j] = h*tab->bembed[j];
673       ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr);
674     } else { /* Rollback and re-complete using (bet-be,be-b) */
675       ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);
676       for (j=0; j<s; j++) w[j] = h*(tab->bembedt[j] - tab->bt[j]);
677       ierr = VecMAXPY(X,tab->s,w,ark->YdotI);CHKERRQ(ierr);
678       for (j=0; j<s; j++) w[j] = h*(tab->bembed[j] - tab->b[j]);
679       ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr);
680     }
681     if (done) *done = PETSC_TRUE;
682     PetscFunctionReturn(0);
683   }
684 unavailable:
685   if (done) *done = PETSC_FALSE;
686   else SETERRQ3(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"ARKIMEX '%s' of order %D cannot evaluate step at order %D. Consider using -ts_adapt_type none or a different method that has an embedded estimate.",tab->name,tab->order,order);
687   PetscFunctionReturn(0);
688 }
689 
690 static PetscErrorCode TSRollBack_ARKIMEX(TS ts)
691 {
692   TS_ARKIMEX      *ark = (TS_ARKIMEX*)ts->data;
693   ARKTableau      tab  = ark->tableau;
694   const PetscInt  s    = tab->s;
695   const PetscReal *bt  = tab->bt,*b = tab->b;
696   PetscScalar     *w   = ark->work;
697   Vec             *YdotI = ark->YdotI,*YdotRHS = ark->YdotRHS;
698   PetscInt        j;
699   PetscReal       h;
700   PetscErrorCode  ierr;
701 
702   PetscFunctionBegin;
703   switch (ark->status) {
704   case TS_STEP_INCOMPLETE:
705   case TS_STEP_PENDING:
706     h = ts->time_step; break;
707   case TS_STEP_COMPLETE:
708     h = ts->ptime - ts->ptime_prev; break;
709   default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus");
710   }
711   for (j=0; j<s; j++) w[j] = -h*bt[j];
712   ierr = VecMAXPY(ts->vec_sol,s,w,YdotI);CHKERRQ(ierr);
713   for (j=0; j<s; j++) w[j] = -h*b[j];
714   ierr = VecMAXPY(ts->vec_sol,s,w,YdotRHS);CHKERRQ(ierr);
715   PetscFunctionReturn(0);
716 }
717 
718 static PetscErrorCode TSStep_ARKIMEX(TS ts)
719 {
720   TS_ARKIMEX      *ark = (TS_ARKIMEX*)ts->data;
721   ARKTableau      tab  = ark->tableau;
722   const PetscInt  s    = tab->s;
723   const PetscReal *At  = tab->At,*A = tab->A,*ct = tab->ct,*c = tab->c;
724   PetscScalar     *w   = ark->work;
725   Vec             *Y   = ark->Y,*YdotI = ark->YdotI,*YdotRHS = ark->YdotRHS,Ydot = ark->Ydot,Ydot0 = ark->Ydot0,Z = ark->Z;
726   PetscBool       extrapolate = ark->extrapolate;
727   TSAdapt         adapt;
728   SNES            snes;
729   PetscInt        i,j,its,lits;
730   PetscInt        rejections = 0;
731   PetscBool       stageok,accept = PETSC_TRUE;
732   PetscReal       next_time_step = ts->time_step;
733   PetscErrorCode  ierr;
734 
735   PetscFunctionBegin;
736   if (ark->extrapolate && !ark->Y_prev) {
737     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->Y_prev);CHKERRQ(ierr);
738     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotI_prev);CHKERRQ(ierr);
739     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotRHS_prev);CHKERRQ(ierr);
740   }
741 
742   if (!ts->steprollback) {
743     if (ts->equation_type >= TS_EQ_IMPLICIT) { /* Save the initial slope for the next step */
744       ierr = VecCopy(YdotI[s-1],Ydot0);CHKERRQ(ierr);
745     }
746     if (ark->extrapolate && !ts->steprestart) { /* Save the Y, YdotI, YdotRHS for extrapolation initial guess */
747       for (i = 0; i<s; i++) {
748         ierr = VecCopy(Y[i],ark->Y_prev[i]);CHKERRQ(ierr);
749         ierr = VecCopy(YdotRHS[i],ark->YdotRHS_prev[i]);CHKERRQ(ierr);
750         ierr = VecCopy(YdotI[i],ark->YdotI_prev[i]);CHKERRQ(ierr);
751       }
752     }
753   }
754 
755   if (ts->equation_type >= TS_EQ_IMPLICIT && tab->explicit_first_stage && ts->steprestart) {
756     TS ts_start;
757     ierr = TSClone(ts,&ts_start);CHKERRQ(ierr);
758     ierr = TSSetSolution(ts_start,ts->vec_sol);CHKERRQ(ierr);
759     ierr = TSSetTime(ts_start,ts->ptime);CHKERRQ(ierr);
760     ierr = TSSetMaxSteps(ts_start,ts->steps+1);CHKERRQ(ierr);
761     ierr = TSSetMaxTime(ts_start,ts->ptime+ts->time_step);CHKERRQ(ierr);
762     ierr = TSSetExactFinalTime(ts_start,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
763     ierr = TSSetTimeStep(ts_start,ts->time_step);CHKERRQ(ierr);
764     ierr = TSSetType(ts_start,TSARKIMEX);CHKERRQ(ierr);
765     ierr = TSARKIMEXSetFullyImplicit(ts_start,PETSC_TRUE);CHKERRQ(ierr);
766     ierr = TSARKIMEXSetType(ts_start,TSARKIMEX1BEE);CHKERRQ(ierr);
767 
768     ierr = TSRestartStep(ts_start);CHKERRQ(ierr);
769     ierr = TSSolve(ts_start,ts->vec_sol);CHKERRQ(ierr);
770     ierr = TSGetTime(ts_start,&ts->ptime);CHKERRQ(ierr);
771     ierr = TSGetTimeStep(ts_start,&ts->time_step);CHKERRQ(ierr);
772 
773     { /* Save the initial slope for the next step */
774       TS_ARKIMEX *ark_start = (TS_ARKIMEX*)ts_start->data;
775       ierr = VecCopy(ark_start->YdotI[ark_start->tableau->s-1],Ydot0);CHKERRQ(ierr);
776     }
777     ts->steps++;
778 
779     /* Set the correct TS in SNES */
780     /* We'll try to bypass this by changing the method on the fly */
781     {
782       ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
783       ierr = TSSetSNES(ts,snes);CHKERRQ(ierr);
784     }
785     ierr = TSDestroy(&ts_start);CHKERRQ(ierr);
786   }
787 
788   ark->status = TS_STEP_INCOMPLETE;
789   while (!ts->reason && ark->status != TS_STEP_COMPLETE) {
790     PetscReal t = ts->ptime;
791     PetscReal h = ts->time_step;
792     for (i=0; i<s; i++) {
793       ark->stage_time = t + h*ct[i];
794       ierr = TSPreStage(ts,ark->stage_time);CHKERRQ(ierr);
795       if (At[i*s+i] == 0) { /* This stage is explicit */
796         if (i!=0 && ts->equation_type >= TS_EQ_IMPLICIT) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Explicit stages other than the first one are not supported for implicit problems");
797         ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr);
798         for (j=0; j<i; j++) w[j] = h*At[i*s+j];
799         ierr = VecMAXPY(Y[i],i,w,YdotI);CHKERRQ(ierr);
800         for (j=0; j<i; j++) w[j] = h*A[i*s+j];
801         ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr);
802       } else {
803         ark->scoeff = 1./At[i*s+i];
804         /* Ydot = shift*(Y-Z) */
805         ierr = VecCopy(ts->vec_sol,Z);CHKERRQ(ierr);
806         for (j=0; j<i; j++) w[j] = h*At[i*s+j];
807         ierr = VecMAXPY(Z,i,w,YdotI);CHKERRQ(ierr);
808         for (j=0; j<i; j++) w[j] = h*A[i*s+j];
809         ierr = VecMAXPY(Z,i,w,YdotRHS);CHKERRQ(ierr);
810         if (extrapolate && !ts->steprestart) {
811           /* Initial guess extrapolated from previous time step stage values */
812           ierr = TSExtrapolate_ARKIMEX(ts,c[i],Y[i]);CHKERRQ(ierr);
813         } else {
814           /* Initial guess taken from last stage */
815           ierr = VecCopy(i>0 ? Y[i-1] : ts->vec_sol,Y[i]);CHKERRQ(ierr);
816         }
817         ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
818         ierr = SNESSolve(snes,NULL,Y[i]);CHKERRQ(ierr);
819         ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
820         ierr = SNESGetLinearSolveIterations(snes,&lits);CHKERRQ(ierr);
821         ts->snes_its += its; ts->ksp_its += lits;
822         ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
823         ierr = TSAdaptCheckStage(adapt,ts,ark->stage_time,Y[i],&stageok);CHKERRQ(ierr);
824         if (!stageok) {
825           /* We are likely rejecting the step because of solver or function domain problems so we should not attempt to
826            * use extrapolation to initialize the solves on the next attempt. */
827           extrapolate = PETSC_FALSE;
828           goto reject_step;
829         }
830       }
831       if (ts->equation_type >= TS_EQ_IMPLICIT) {
832         if (i==0 && tab->explicit_first_stage) {
833           if (!tab->stiffly_accurate ) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s is not stiffly accurate and therefore explicit-first stage methods cannot be used if the equation is implicit because the slope cannot be evaluated",ark->tableau->name);
834           ierr = VecCopy(Ydot0,YdotI[0]);CHKERRQ(ierr);                                      /* YdotI = YdotI(tn-1) */
835         } else {
836           ierr = VecAXPBYPCZ(YdotI[i],-ark->scoeff/h,ark->scoeff/h,0,Z,Y[i]);CHKERRQ(ierr);  /* YdotI = shift*(X-Z) */
837         }
838       } else {
839         if (i==0 && tab->explicit_first_stage) {
840           ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
841           ierr = TSComputeIFunction(ts,t+h*ct[i],Y[i],Ydot,YdotI[i],ark->imex);CHKERRQ(ierr);/* YdotI = -G(t,Y,0)   */
842           ierr = VecScale(YdotI[i],-1.0);CHKERRQ(ierr);
843         } else {
844           ierr = VecAXPBYPCZ(YdotI[i],-ark->scoeff/h,ark->scoeff/h,0,Z,Y[i]);CHKERRQ(ierr);  /* YdotI = shift*(X-Z) */
845         }
846         if (ark->imex) {
847           ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr);
848         } else {
849           ierr = VecZeroEntries(YdotRHS[i]);CHKERRQ(ierr);
850         }
851       }
852       ierr = TSPostStage(ts,ark->stage_time,i,Y); CHKERRQ(ierr);
853     }
854 
855     ark->status = TS_STEP_INCOMPLETE;
856     ierr = TSEvaluateStep_ARKIMEX(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr);
857     ark->status = TS_STEP_PENDING;
858     ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
859     ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr);
860     ierr = TSAdaptCandidateAdd(adapt,tab->name,tab->order,1,tab->ccfl,(PetscReal)tab->s,PETSC_TRUE);CHKERRQ(ierr);
861     ierr = TSAdaptChoose(adapt,ts,ts->time_step,NULL,&next_time_step,&accept);CHKERRQ(ierr);
862     ark->status = accept ? TS_STEP_COMPLETE : TS_STEP_INCOMPLETE;
863     if (!accept) { /* Roll back the current step */
864       ierr = TSRollBack_ARKIMEX(ts);CHKERRQ(ierr);
865       ts->time_step = next_time_step;
866       goto reject_step;
867     }
868 
869     ts->ptime += ts->time_step;
870     ts->time_step = next_time_step;
871     break;
872 
873   reject_step:
874     ts->reject++; accept = PETSC_FALSE;
875     if (!ts->reason && ++rejections > ts->max_reject && ts->max_reject >= 0) {
876       ts->reason = TS_DIVERGED_STEP_REJECTED;
877       ierr = PetscInfo2(ts,"Step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,rejections);CHKERRQ(ierr);
878     }
879   }
880   PetscFunctionReturn(0);
881 }
882 
883 static PetscErrorCode TSInterpolate_ARKIMEX(TS ts,PetscReal itime,Vec X)
884 {
885   TS_ARKIMEX      *ark = (TS_ARKIMEX*)ts->data;
886   PetscInt        s    = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j;
887   PetscReal       h;
888   PetscReal       tt,t;
889   PetscScalar     *bt,*b;
890   const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp;
891   PetscErrorCode  ierr;
892 
893   PetscFunctionBegin;
894   if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name);
895   switch (ark->status) {
896   case TS_STEP_INCOMPLETE:
897   case TS_STEP_PENDING:
898     h = ts->time_step;
899     t = (itime - ts->ptime)/h;
900     break;
901   case TS_STEP_COMPLETE:
902     h = ts->ptime - ts->ptime_prev;
903     t = (itime - ts->ptime)/h + 1; /* In the interval [0,1] */
904     break;
905   default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus");
906   }
907   ierr = PetscMalloc2(s,&bt,s,&b);CHKERRQ(ierr);
908   for (i=0; i<s; i++) bt[i] = b[i] = 0;
909   for (j=0,tt=t; j<pinterp; j++,tt*=t) {
910     for (i=0; i<s; i++) {
911       bt[i] += h * Bt[i*pinterp+j] * tt;
912       b[i]  += h * B[i*pinterp+j] * tt;
913     }
914   }
915   ierr = VecCopy(ark->Y[0],X);CHKERRQ(ierr);
916   ierr = VecMAXPY(X,s,bt,ark->YdotI);CHKERRQ(ierr);
917   ierr = VecMAXPY(X,s,b,ark->YdotRHS);CHKERRQ(ierr);
918   ierr = PetscFree2(bt,b);CHKERRQ(ierr);
919   PetscFunctionReturn(0);
920 }
921 
922 static PetscErrorCode TSExtrapolate_ARKIMEX(TS ts,PetscReal c,Vec X)
923 {
924   TS_ARKIMEX      *ark = (TS_ARKIMEX*)ts->data;
925   PetscInt        s = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j;
926   PetscReal       h,h_prev,t,tt;
927   PetscScalar     *bt,*b;
928   const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp;
929   PetscErrorCode  ierr;
930 
931   PetscFunctionBegin;
932   if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name);
933   ierr = PetscCalloc2(s,&bt,s,&b);CHKERRQ(ierr);
934   h = ts->time_step;
935   h_prev = ts->ptime - ts->ptime_prev;
936   t = 1 + h/h_prev*c;
937   for (j=0,tt=t; j<pinterp; j++,tt*=t) {
938     for (i=0; i<s; i++) {
939       bt[i] += h * Bt[i*pinterp+j] * tt;
940       b[i]  += h * B[i*pinterp+j] * tt;
941     }
942   }
943   if (!ark->Y_prev) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Stages from previous step have not been stored");
944   ierr = VecCopy(ark->Y_prev[0],X);CHKERRQ(ierr);
945   ierr = VecMAXPY(X,s,bt,ark->YdotI_prev);CHKERRQ(ierr);
946   ierr = VecMAXPY(X,s,b,ark->YdotRHS_prev);CHKERRQ(ierr);
947   ierr = PetscFree2(bt,b);CHKERRQ(ierr);
948   PetscFunctionReturn(0);
949 }
950 
951 /*------------------------------------------------------------*/
952 
953 static PetscErrorCode TSARKIMEXTableauReset(TS ts)
954 {
955   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
956   ARKTableau     tab  = ark->tableau;
957   PetscErrorCode ierr;
958 
959   PetscFunctionBegin;
960   if (!tab) PetscFunctionReturn(0);
961   ierr = PetscFree(ark->work);CHKERRQ(ierr);
962   ierr = VecDestroyVecs(tab->s,&ark->Y);CHKERRQ(ierr);
963   ierr = VecDestroyVecs(tab->s,&ark->YdotI);CHKERRQ(ierr);
964   ierr = VecDestroyVecs(tab->s,&ark->YdotRHS);CHKERRQ(ierr);
965   ierr = VecDestroyVecs(tab->s,&ark->Y_prev);CHKERRQ(ierr);
966   ierr = VecDestroyVecs(tab->s,&ark->YdotI_prev);CHKERRQ(ierr);
967   ierr = VecDestroyVecs(tab->s,&ark->YdotRHS_prev);CHKERRQ(ierr);
968   PetscFunctionReturn(0);
969 }
970 
971 static PetscErrorCode TSReset_ARKIMEX(TS ts)
972 {
973   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
974   PetscErrorCode ierr;
975 
976   PetscFunctionBegin;
977   ierr = TSARKIMEXTableauReset(ts);CHKERRQ(ierr);
978   ierr = VecDestroy(&ark->Ydot);CHKERRQ(ierr);
979   ierr = VecDestroy(&ark->Ydot0);CHKERRQ(ierr);
980   ierr = VecDestroy(&ark->Z);CHKERRQ(ierr);
981   PetscFunctionReturn(0);
982 }
983 
984 static PetscErrorCode TSARKIMEXGetVecs(TS ts,DM dm,Vec *Z,Vec *Ydot)
985 {
986   TS_ARKIMEX     *ax = (TS_ARKIMEX*)ts->data;
987   PetscErrorCode ierr;
988 
989   PetscFunctionBegin;
990   if (Z) {
991     if (dm && dm != ts->dm) {
992       ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr);
993     } else *Z = ax->Z;
994   }
995   if (Ydot) {
996     if (dm && dm != ts->dm) {
997       ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr);
998     } else *Ydot = ax->Ydot;
999   }
1000   PetscFunctionReturn(0);
1001 }
1002 
1003 
1004 static PetscErrorCode TSARKIMEXRestoreVecs(TS ts,DM dm,Vec *Z,Vec *Ydot)
1005 {
1006   PetscErrorCode ierr;
1007 
1008   PetscFunctionBegin;
1009   if (Z) {
1010     if (dm && dm != ts->dm) {
1011       ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr);
1012     }
1013   }
1014   if (Ydot) {
1015     if (dm && dm != ts->dm) {
1016       ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr);
1017     }
1018   }
1019   PetscFunctionReturn(0);
1020 }
1021 
1022 /*
1023   This defines the nonlinear equation that is to be solved with SNES
1024   G(U) = F[t0+Theta*dt, U, (U-U0)*shift] = 0
1025 */
1026 static PetscErrorCode SNESTSFormFunction_ARKIMEX(SNES snes,Vec X,Vec F,TS ts)
1027 {
1028   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1029   DM             dm,dmsave;
1030   Vec            Z,Ydot;
1031   PetscReal      shift = ark->scoeff / ts->time_step;
1032   PetscErrorCode ierr;
1033 
1034   PetscFunctionBegin;
1035   ierr   = SNESGetDM(snes,&dm);CHKERRQ(ierr);
1036   ierr   = TSARKIMEXGetVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr);
1037   ierr   = VecAXPBYPCZ(Ydot,-shift,shift,0,Z,X);CHKERRQ(ierr); /* Ydot = shift*(X-Z) */
1038   dmsave = ts->dm;
1039   ts->dm = dm;
1040 
1041   ierr = TSComputeIFunction(ts,ark->stage_time,X,Ydot,F,ark->imex);CHKERRQ(ierr);
1042 
1043   ts->dm = dmsave;
1044   ierr   = TSARKIMEXRestoreVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr);
1045   PetscFunctionReturn(0);
1046 }
1047 
1048 static PetscErrorCode SNESTSFormJacobian_ARKIMEX(SNES snes,Vec X,Mat A,Mat B,TS ts)
1049 {
1050   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1051   DM             dm,dmsave;
1052   Vec            Ydot;
1053   PetscReal      shift = ark->scoeff / ts->time_step;
1054   PetscErrorCode ierr;
1055 
1056   PetscFunctionBegin;
1057   ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
1058   ierr = TSARKIMEXGetVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr);
1059   /* ark->Ydot has already been computed in SNESTSFormFunction_ARKIMEX (SNES guarantees this) */
1060   dmsave = ts->dm;
1061   ts->dm = dm;
1062 
1063   ierr = TSComputeIJacobian(ts,ark->stage_time,X,Ydot,shift,A,B,ark->imex);CHKERRQ(ierr);
1064 
1065   ts->dm = dmsave;
1066   ierr   = TSARKIMEXRestoreVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr);
1067   PetscFunctionReturn(0);
1068 }
1069 
1070 static PetscErrorCode DMCoarsenHook_TSARKIMEX(DM fine,DM coarse,void *ctx)
1071 {
1072   PetscFunctionBegin;
1073   PetscFunctionReturn(0);
1074 }
1075 
1076 static PetscErrorCode DMRestrictHook_TSARKIMEX(DM fine,Mat restrct,Vec rscale,Mat inject,DM coarse,void *ctx)
1077 {
1078   TS             ts = (TS)ctx;
1079   PetscErrorCode ierr;
1080   Vec            Z,Z_c;
1081 
1082   PetscFunctionBegin;
1083   ierr = TSARKIMEXGetVecs(ts,fine,&Z,NULL);CHKERRQ(ierr);
1084   ierr = TSARKIMEXGetVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr);
1085   ierr = MatRestrict(restrct,Z,Z_c);CHKERRQ(ierr);
1086   ierr = VecPointwiseMult(Z_c,rscale,Z_c);CHKERRQ(ierr);
1087   ierr = TSARKIMEXRestoreVecs(ts,fine,&Z,NULL);CHKERRQ(ierr);
1088   ierr = TSARKIMEXRestoreVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr);
1089   PetscFunctionReturn(0);
1090 }
1091 
1092 
1093 static PetscErrorCode DMSubDomainHook_TSARKIMEX(DM dm,DM subdm,void *ctx)
1094 {
1095   PetscFunctionBegin;
1096   PetscFunctionReturn(0);
1097 }
1098 
1099 static PetscErrorCode DMSubDomainRestrictHook_TSARKIMEX(DM dm,VecScatter gscat,VecScatter lscat,DM subdm,void *ctx)
1100 {
1101   TS             ts = (TS)ctx;
1102   PetscErrorCode ierr;
1103   Vec            Z,Z_c;
1104 
1105   PetscFunctionBegin;
1106   ierr = TSARKIMEXGetVecs(ts,dm,&Z,NULL);CHKERRQ(ierr);
1107   ierr = TSARKIMEXGetVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr);
1108 
1109   ierr = VecScatterBegin(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1110   ierr = VecScatterEnd(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1111 
1112   ierr = TSARKIMEXRestoreVecs(ts,dm,&Z,NULL);CHKERRQ(ierr);
1113   ierr = TSARKIMEXRestoreVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr);
1114   PetscFunctionReturn(0);
1115 }
1116 
1117 static PetscErrorCode TSARKIMEXTableauSetUp(TS ts)
1118 {
1119   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1120   ARKTableau     tab  = ark->tableau;
1121   PetscErrorCode ierr;
1122 
1123   PetscFunctionBegin;
1124   ierr = PetscMalloc1(tab->s,&ark->work);CHKERRQ(ierr);
1125   ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->Y);CHKERRQ(ierr);
1126   ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotI);CHKERRQ(ierr);
1127   ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotRHS);CHKERRQ(ierr);
1128   if (ark->extrapolate) {
1129     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->Y_prev);CHKERRQ(ierr);
1130     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotI_prev);CHKERRQ(ierr);
1131     ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&ark->YdotRHS_prev);CHKERRQ(ierr);
1132   }
1133   PetscFunctionReturn(0);
1134 }
1135 
1136 static PetscErrorCode TSSetUp_ARKIMEX(TS ts)
1137 {
1138   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1139   PetscErrorCode ierr;
1140   DM             dm;
1141   SNES           snes;
1142 
1143   PetscFunctionBegin;
1144   ierr = TSARKIMEXTableauSetUp(ts);CHKERRQ(ierr);
1145   ierr = VecDuplicate(ts->vec_sol,&ark->Ydot);CHKERRQ(ierr);
1146   ierr = VecDuplicate(ts->vec_sol,&ark->Ydot0);CHKERRQ(ierr);
1147   ierr = VecDuplicate(ts->vec_sol,&ark->Z);CHKERRQ(ierr);
1148   ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
1149   ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSARKIMEX,DMRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr);
1150   ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSARKIMEX,DMSubDomainRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr);
1151   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1152   PetscFunctionReturn(0);
1153 }
1154 /*------------------------------------------------------------*/
1155 
1156 static PetscErrorCode TSSetFromOptions_ARKIMEX(PetscOptionItems *PetscOptionsObject,TS ts)
1157 {
1158   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1159   PetscErrorCode ierr;
1160 
1161   PetscFunctionBegin;
1162   ierr = PetscOptionsHead(PetscOptionsObject,"ARKIMEX ODE solver options");CHKERRQ(ierr);
1163   {
1164     ARKTableauLink link;
1165     PetscInt       count,choice;
1166     PetscBool      flg;
1167     const char     **namelist;
1168     for (link=ARKTableauList,count=0; link; link=link->next,count++) ;
1169     ierr = PetscMalloc1(count,(char***)&namelist);CHKERRQ(ierr);
1170     for (link=ARKTableauList,count=0; link; link=link->next,count++) namelist[count] = link->tab.name;
1171     ierr = PetscOptionsEList("-ts_arkimex_type","Family of ARK IMEX method","TSARKIMEXSetType",(const char*const*)namelist,count,ark->tableau->name,&choice,&flg);CHKERRQ(ierr);
1172     if (flg) {ierr = TSARKIMEXSetType(ts,namelist[choice]);CHKERRQ(ierr);}
1173     ierr = PetscFree(namelist);CHKERRQ(ierr);
1174 
1175     flg  = (PetscBool) !ark->imex;
1176     ierr = PetscOptionsBool("-ts_arkimex_fully_implicit","Solve the problem fully implicitly","TSARKIMEXSetFullyImplicit",flg,&flg,NULL);CHKERRQ(ierr);
1177     ark->imex = (PetscBool) !flg;
1178     ierr = PetscOptionsBool("-ts_arkimex_initial_guess_extrapolate","Extrapolate the initial guess for the stage solution from stage values of the previous time step","",ark->extrapolate,&ark->extrapolate,NULL);CHKERRQ(ierr);
1179   }
1180   ierr = PetscOptionsTail();CHKERRQ(ierr);
1181   PetscFunctionReturn(0);
1182 }
1183 
1184 static PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
1185 {
1186   PetscErrorCode ierr;
1187   PetscInt       i;
1188   size_t         left,count;
1189   char           *p;
1190 
1191   PetscFunctionBegin;
1192   for (i=0,p=buf,left=len; i<n; i++) {
1193     ierr = PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);CHKERRQ(ierr);
1194     if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
1195     left -= count;
1196     p    += count;
1197     *p++  = ' ';
1198   }
1199   p[i ? 0 : -1] = 0;
1200   PetscFunctionReturn(0);
1201 }
1202 
1203 static PetscErrorCode TSView_ARKIMEX(TS ts,PetscViewer viewer)
1204 {
1205   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1206   PetscBool      iascii;
1207   PetscErrorCode ierr;
1208 
1209   PetscFunctionBegin;
1210   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1211   if (iascii) {
1212     ARKTableau    tab = ark->tableau;
1213     TSARKIMEXType arktype;
1214     char          buf[512];
1215     ierr = TSARKIMEXGetType(ts,&arktype);CHKERRQ(ierr);
1216     ierr = PetscViewerASCIIPrintf(viewer,"  ARK IMEX %s\n",arktype);CHKERRQ(ierr);
1217     ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->ct);CHKERRQ(ierr);
1218     ierr = PetscViewerASCIIPrintf(viewer,"  Stiff abscissa       ct = %s\n",buf);CHKERRQ(ierr);
1219     ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->c);CHKERRQ(ierr);
1220     ierr = PetscViewerASCIIPrintf(viewer,"Stiffly accurate: %s\n",tab->stiffly_accurate ? "yes" : "no");CHKERRQ(ierr);
1221     ierr = PetscViewerASCIIPrintf(viewer,"Explicit first stage: %s\n",tab->explicit_first_stage ? "yes" : "no");CHKERRQ(ierr);
1222     ierr = PetscViewerASCIIPrintf(viewer,"FSAL property: %s\n",tab->FSAL_implicit ? "yes" : "no");CHKERRQ(ierr);
1223     ierr = PetscViewerASCIIPrintf(viewer,"  Nonstiff abscissa     c = %s\n",buf);CHKERRQ(ierr);
1224   }
1225   PetscFunctionReturn(0);
1226 }
1227 
1228 static PetscErrorCode TSLoad_ARKIMEX(TS ts,PetscViewer viewer)
1229 {
1230   PetscErrorCode ierr;
1231   SNES           snes;
1232   TSAdapt        adapt;
1233 
1234   PetscFunctionBegin;
1235   ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
1236   ierr = TSAdaptLoad(adapt,viewer);CHKERRQ(ierr);
1237   ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
1238   ierr = SNESLoad(snes,viewer);CHKERRQ(ierr);
1239   /* function and Jacobian context for SNES when used with TS is always ts object */
1240   ierr = SNESSetFunction(snes,NULL,NULL,ts);CHKERRQ(ierr);
1241   ierr = SNESSetJacobian(snes,NULL,NULL,NULL,ts);CHKERRQ(ierr);
1242   PetscFunctionReturn(0);
1243 }
1244 
1245 /*@C
1246   TSARKIMEXSetType - Set the type of ARK IMEX scheme
1247 
1248   Logically collective
1249 
1250   Input Parameter:
1251 +  ts - timestepping context
1252 -  arktype - type of ARK-IMEX scheme
1253 
1254   Options Database:
1255 .  -ts_arkimex_type <1bee,a2,l2,ars122,2c,2d,2e,prssp2,3,bpr3,ars443,4,5>
1256 
1257   Level: intermediate
1258 
1259 .seealso: TSARKIMEXGetType(), TSARKIMEX, TSARKIMEXType, TSARKIMEX1BEE, TSARKIMEXA2, TSARKIMEXL2, TSARKIMEXARS122, TSARKIMEX2C, TSARKIMEX2D, TSARKIMEX2E, TSARKIMEXPRSSP2,
1260           TSARKIMEX3, TSARKIMEXBPR3, TSARKIMEXARS443, TSARKIMEX4, TSARKIMEX5
1261 @*/
1262 PetscErrorCode TSARKIMEXSetType(TS ts,TSARKIMEXType arktype)
1263 {
1264   PetscErrorCode ierr;
1265 
1266   PetscFunctionBegin;
1267   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1268   PetscValidCharPointer(arktype,2);
1269   ierr = PetscTryMethod(ts,"TSARKIMEXSetType_C",(TS,TSARKIMEXType),(ts,arktype));CHKERRQ(ierr);
1270   PetscFunctionReturn(0);
1271 }
1272 
1273 /*@C
1274   TSARKIMEXGetType - Get the type of ARK IMEX scheme
1275 
1276   Logically collective
1277 
1278   Input Parameter:
1279 .  ts - timestepping context
1280 
1281   Output Parameter:
1282 .  arktype - type of ARK-IMEX scheme
1283 
1284   Level: intermediate
1285 
1286 .seealso: TSARKIMEXGetType()
1287 @*/
1288 PetscErrorCode TSARKIMEXGetType(TS ts,TSARKIMEXType *arktype)
1289 {
1290   PetscErrorCode ierr;
1291 
1292   PetscFunctionBegin;
1293   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1294   ierr = PetscUseMethod(ts,"TSARKIMEXGetType_C",(TS,TSARKIMEXType*),(ts,arktype));CHKERRQ(ierr);
1295   PetscFunctionReturn(0);
1296 }
1297 
1298 /*@
1299   TSARKIMEXSetFullyImplicit - Solve both parts of the equation implicitly
1300 
1301   Logically collective
1302 
1303   Input Parameter:
1304 +  ts - timestepping context
1305 -  flg - PETSC_TRUE for fully implicit
1306 
1307   Level: intermediate
1308 
1309 .seealso: TSARKIMEXGetType()
1310 @*/
1311 PetscErrorCode TSARKIMEXSetFullyImplicit(TS ts,PetscBool flg)
1312 {
1313   PetscErrorCode ierr;
1314 
1315   PetscFunctionBegin;
1316   PetscValidHeaderSpecific(ts,TS_CLASSID,1);
1317   ierr = PetscTryMethod(ts,"TSARKIMEXSetFullyImplicit_C",(TS,PetscBool),(ts,flg));CHKERRQ(ierr);
1318   PetscFunctionReturn(0);
1319 }
1320 
1321 static PetscErrorCode  TSARKIMEXGetType_ARKIMEX(TS ts,TSARKIMEXType *arktype)
1322 {
1323   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1324 
1325   PetscFunctionBegin;
1326   *arktype = ark->tableau->name;
1327   PetscFunctionReturn(0);
1328 }
1329 static PetscErrorCode  TSARKIMEXSetType_ARKIMEX(TS ts,TSARKIMEXType arktype)
1330 {
1331   TS_ARKIMEX     *ark = (TS_ARKIMEX*)ts->data;
1332   PetscErrorCode ierr;
1333   PetscBool      match;
1334   ARKTableauLink link;
1335 
1336   PetscFunctionBegin;
1337   if (ark->tableau) {
1338     ierr = PetscStrcmp(ark->tableau->name,arktype,&match);CHKERRQ(ierr);
1339     if (match) PetscFunctionReturn(0);
1340   }
1341   for (link = ARKTableauList; link; link=link->next) {
1342     ierr = PetscStrcmp(link->tab.name,arktype,&match);CHKERRQ(ierr);
1343     if (match) {
1344       if (ts->setupcalled) {ierr = TSARKIMEXTableauReset(ts);CHKERRQ(ierr);}
1345       ark->tableau = &link->tab;
1346       if (ts->setupcalled) {ierr = TSARKIMEXTableauSetUp(ts);CHKERRQ(ierr);}
1347       ts->default_adapt_type = ark->tableau->bembed ? TSADAPTBASIC : TSADAPTNONE;
1348       PetscFunctionReturn(0);
1349     }
1350   }
1351   SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_UNKNOWN_TYPE,"Could not find '%s'",arktype);
1352   PetscFunctionReturn(0);
1353 }
1354 
1355 static PetscErrorCode  TSARKIMEXSetFullyImplicit_ARKIMEX(TS ts,PetscBool flg)
1356 {
1357   TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data;
1358 
1359   PetscFunctionBegin;
1360   ark->imex = (PetscBool)!flg;
1361   PetscFunctionReturn(0);
1362 }
1363 
1364 static PetscErrorCode TSDestroy_ARKIMEX(TS ts)
1365 {
1366   PetscErrorCode ierr;
1367 
1368   PetscFunctionBegin;
1369   ierr = TSReset_ARKIMEX(ts);CHKERRQ(ierr);
1370   if (ts->dm) {
1371     ierr = DMCoarsenHookRemove(ts->dm,DMCoarsenHook_TSARKIMEX,DMRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr);
1372     ierr = DMSubDomainHookRemove(ts->dm,DMSubDomainHook_TSARKIMEX,DMSubDomainRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr);
1373   }
1374   ierr = PetscFree(ts->data);CHKERRQ(ierr);
1375   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",NULL);CHKERRQ(ierr);
1376   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",NULL);CHKERRQ(ierr);
1377   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",NULL);CHKERRQ(ierr);
1378   PetscFunctionReturn(0);
1379 }
1380 
1381 /* ------------------------------------------------------------ */
1382 /*MC
1383       TSARKIMEX - ODE and DAE solver using Additive Runge-Kutta IMEX schemes
1384 
1385   These methods are intended for problems with well-separated time scales, especially when a slow scale is strongly
1386   nonlinear such that it is expensive to solve with a fully implicit method. The user should provide the stiff part
1387   of the equation using TSSetIFunction() and the non-stiff part with TSSetRHSFunction().
1388 
1389   Notes:
1390   The default is TSARKIMEX3, it can be changed with TSARKIMEXSetType() or -ts_arkimex_type
1391 
1392   If the equation is implicit or a DAE, then TSSetEquationType() needs to be set accordingly. Refer to the manual for further information.
1393 
1394   Methods with an explicit stage can only be used with ODE in which the stiff part G(t,X,Xdot) has the form Xdot + Ghat(t,X).
1395 
1396   Consider trying TSROSW if the stiff part is linear or weakly nonlinear.
1397 
1398   Level: beginner
1399 
1400 .seealso:  TSCreate(), TS, TSSetType(), TSARKIMEXSetType(), TSARKIMEXGetType(), TSARKIMEXSetFullyImplicit(), TSARKIMEX1BEE,
1401            TSARKIMEX2C, TSARKIMEX2D, TSARKIMEX2E, TSARKIMEX3, TSARKIMEXL2, TSARKIMEXA2, TSARKIMEXARS122,
1402            TSARKIMEX4, TSARKIMEX5, TSARKIMEXPRSSP2, TSARKIMEXARS443, TSARKIMEXBPR3, TSARKIMEXType, TSARKIMEXRegister()
1403 
1404 M*/
1405 PETSC_EXTERN PetscErrorCode TSCreate_ARKIMEX(TS ts)
1406 {
1407   TS_ARKIMEX     *th;
1408   PetscErrorCode ierr;
1409 
1410   PetscFunctionBegin;
1411   ierr = TSARKIMEXInitializePackage();CHKERRQ(ierr);
1412 
1413   ts->ops->reset          = TSReset_ARKIMEX;
1414   ts->ops->destroy        = TSDestroy_ARKIMEX;
1415   ts->ops->view           = TSView_ARKIMEX;
1416   ts->ops->load           = TSLoad_ARKIMEX;
1417   ts->ops->setup          = TSSetUp_ARKIMEX;
1418   ts->ops->step           = TSStep_ARKIMEX;
1419   ts->ops->interpolate    = TSInterpolate_ARKIMEX;
1420   ts->ops->evaluatestep   = TSEvaluateStep_ARKIMEX;
1421   ts->ops->rollback       = TSRollBack_ARKIMEX;
1422   ts->ops->setfromoptions = TSSetFromOptions_ARKIMEX;
1423   ts->ops->snesfunction   = SNESTSFormFunction_ARKIMEX;
1424   ts->ops->snesjacobian   = SNESTSFormJacobian_ARKIMEX;
1425 
1426   ts->usessnes = PETSC_TRUE;
1427 
1428   ierr = PetscNewLog(ts,&th);CHKERRQ(ierr);
1429   ts->data = (void*)th;
1430   th->imex = PETSC_TRUE;
1431 
1432   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",TSARKIMEXGetType_ARKIMEX);CHKERRQ(ierr);
1433   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",TSARKIMEXSetType_ARKIMEX);CHKERRQ(ierr);
1434   ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",TSARKIMEXSetFullyImplicit_ARKIMEX);CHKERRQ(ierr);
1435 
1436   ierr = TSARKIMEXSetType(ts,TSARKIMEXDefault);CHKERRQ(ierr);
1437   PetscFunctionReturn(0);
1438 }
1439