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