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