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