xref: /petsc/src/ts/tutorials/multirate/ex4.c (revision a16fd2c93c02146fccd68469496ac02ca99b9ebe)
1 /*
2   Note:
3     -hratio is the ratio between mesh size of coarse grids and fine grids
4 */
5 
6 static const char help[] = "1D periodic Finite Volume solver in slope-limiter form with semidiscrete time stepping.\n"
7                            "  advect      - Constant coefficient scalar advection\n"
8                            "                u_t       + (a*u)_x               = 0\n"
9                            "  shallow     - 1D Shallow water equations (Saint Venant System)\n"
10                            "                h_t + (q)_x = 0 \n"
11                            "                q_t + (\frac{q^2}{h} + g/2*h^2)_x = 0  \n"
12                            "                where, h(x,t) denotes the height of the water and q(x,t) the momentum.\n"
13                            "  for this toy problem, we choose different meshsizes for different sub-domains (slow-fast-slow), say\n"
14                            "                hxs  = hratio*hxf \n"
15                            "  where hxs and hxf are the grid spacings for coarse and fine grids respectively.\n"
16                            "  exact       - Exact Riemann solver which usually needs to perform a Newton iteration to connect\n"
17                            "                the states across shocks and rarefactions\n"
18                            "  simulation  - use reference solution which is generated by smaller time step size to be true solution,\n"
19                            "                also the reference solution should be generated by user and stored in a binary file.\n"
20                            "  characteristic - Limit the characteristic variables, this is usually preferred (default)\n"
21                            "  bc_type     - Boundary condition for the problem, options are: periodic, outflow, inflow "
22                            "Several problem descriptions (initial data, physics specific features, boundary data) can be chosen with -initial N\n\n"
23                            "The problem size should be set with -da_grid_x M\n\n";
24 
25 /*
26   Example:
27      ./ex4 -da_grid_x 40 -initial 1 -hratio 1 -limit mc -ts_dt 0.01 -ts_max_time 7.0 -ts_type mprk -ts_mprk_type 2a22 -ts_monitor_draw_solution -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
28      ./ex4 -da_grid_x 40 -initial 2 -hratio 1 -limit mc -ts_dt 0.01 -ts_max_time 2.5 -ts_type mprk -ts_mprk_type 2a22 -ts_monitor_draw_solution -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
29      ./ex4 -da_grid_x 40 -initial 3 -hratio 1 -limit mc -ts_dt 0.01 -ts_max_time 4.0 -ts_type mprk -ts_mprk_type 2a22 -ts_monitor_draw_solution -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
30      ./ex4 -da_grid_x 40 -initial 4 -hratio 1 -limit koren3 -ts_dt 0.01 -ts_max_time 4.0 -ts_type mprk -ts_mprk_type 2a22 -ts_monitor_draw_solution -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
31      ./ex4 -da_grid_x 40 -initial 5 -hratio 1 -limit mc -ts_dt 0.01 -ts_max_time 5.0 -ts_type mprk -ts_mprk_type 2a22 -ts_monitor_draw_solution -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
32 
33   Contributed by: Aidan Hamilton <aidan@udel.edu>
34 */
35 
36 #include <petscts.h>
37 #include <petscdm.h>
38 #include <petscdmda.h>
39 #include <petscdraw.h>
40 #include "finitevolume1d.h"
41 #include <petsc/private/kernels/blockinvert.h>
42 
43 static inline PetscReal RangeMod(PetscReal a, PetscReal xmin, PetscReal xmax) {
44   PetscReal range = xmax - xmin;
45   return xmin + PetscFmodReal(range + PetscFmodReal(a, range), range);
46 }
47 static inline PetscReal MaxAbs(PetscReal a, PetscReal b) {
48   return (PetscAbs(a) > PetscAbs(b)) ? a : b;
49 }
50 /* --------------------------------- Advection ----------------------------------- */
51 typedef struct {
52   PetscReal a; /* advective velocity */
53 } AdvectCtx;
54 
55 static PetscErrorCode PhysicsRiemann_Advect(void *vctx, PetscInt m, const PetscScalar *uL, const PetscScalar *uR, PetscScalar *flux, PetscReal *maxspeed) {
56   AdvectCtx *ctx = (AdvectCtx *)vctx;
57   PetscReal  speed;
58 
59   PetscFunctionBeginUser;
60   speed     = ctx->a;
61   flux[0]   = PetscMax(0, speed) * uL[0] + PetscMin(0, speed) * uR[0];
62   *maxspeed = speed;
63   PetscFunctionReturn(0);
64 }
65 
66 static PetscErrorCode PhysicsCharacteristic_Advect(void *vctx, PetscInt m, const PetscScalar *u, PetscScalar *X, PetscScalar *Xi, PetscReal *speeds) {
67   AdvectCtx *ctx = (AdvectCtx *)vctx;
68 
69   PetscFunctionBeginUser;
70   X[0]      = 1.;
71   Xi[0]     = 1.;
72   speeds[0] = ctx->a;
73   PetscFunctionReturn(0);
74 }
75 
76 static PetscErrorCode PhysicsSample_Advect(void *vctx, PetscInt initial, FVBCType bctype, PetscReal xmin, PetscReal xmax, PetscReal t, PetscReal x, PetscReal *u) {
77   AdvectCtx *ctx = (AdvectCtx *)vctx;
78   PetscReal  a   = ctx->a, x0;
79 
80   PetscFunctionBeginUser;
81   switch (bctype) {
82   case FVBC_OUTFLOW: x0 = x - a * t; break;
83   case FVBC_PERIODIC: x0 = RangeMod(x - a * t, xmin, xmax); break;
84   default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "unknown BCType");
85   }
86   switch (initial) {
87   case 0: u[0] = (x0 < 0) ? 1 : -1; break;
88   case 1: u[0] = (x0 < 0) ? -1 : 1; break;
89   case 2: u[0] = (0 < x0 && x0 < 1) ? 1 : 0; break;
90   case 3: u[0] = PetscSinReal(2 * PETSC_PI * x0); break;
91   case 4: u[0] = PetscAbs(x0); break;
92   case 5: u[0] = (x0 < 0 || x0 > 0.5) ? 0 : PetscSqr(PetscSinReal(2 * PETSC_PI * x0)); break;
93   case 6: u[0] = (x0 < 0) ? 0 : ((x0 < 1) ? x0 : ((x0 < 2) ? 2 - x0 : 0)); break;
94   case 7: u[0] = PetscPowReal(PetscSinReal(PETSC_PI * x0), 10.0); break;
95   default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "unknown initial condition");
96   }
97   PetscFunctionReturn(0);
98 }
99 
100 static PetscErrorCode PhysicsCreate_Advect(FVCtx *ctx) {
101   AdvectCtx *user;
102 
103   PetscFunctionBeginUser;
104   PetscCall(PetscNew(&user));
105   ctx->physics2.sample2         = PhysicsSample_Advect;
106   ctx->physics2.riemann2        = PhysicsRiemann_Advect;
107   ctx->physics2.characteristic2 = PhysicsCharacteristic_Advect;
108   ctx->physics2.destroy         = PhysicsDestroy_SimpleFree;
109   ctx->physics2.user            = user;
110   ctx->physics2.dof             = 1;
111 
112   PetscCall(PetscStrallocpy("u", &ctx->physics2.fieldname[0]));
113   user->a = 1;
114   PetscOptionsBegin(ctx->comm, ctx->prefix, "Options for advection", "");
115   PetscCall(PetscOptionsReal("-physics_advect_a", "Speed", "", user->a, &user->a, NULL));
116   PetscOptionsEnd();
117   PetscFunctionReturn(0);
118 }
119 /* --------------------------------- Shallow Water ----------------------------------- */
120 
121 typedef struct {
122   PetscReal gravity;
123 } ShallowCtx;
124 
125 static inline void ShallowFlux(ShallowCtx *phys, const PetscScalar *u, PetscScalar *f) {
126   f[0] = u[1];
127   f[1] = PetscSqr(u[1]) / u[0] + 0.5 * phys->gravity * PetscSqr(u[0]);
128 }
129 
130 static PetscErrorCode PhysicsRiemann_Shallow_Exact(void *vctx, PetscInt m, const PetscScalar *uL, const PetscScalar *uR, PetscScalar *flux, PetscReal *maxspeed) {
131   ShallowCtx *phys = (ShallowCtx *)vctx;
132   PetscScalar g    = phys->gravity, ustar[2], cL, cR, c, cstar;
133   struct {
134     PetscScalar h, u;
135   } L = {uL[0], uL[1] / uL[0]}, R = {uR[0], uR[1] / uR[0]}, star;
136   PetscInt i;
137 
138   PetscFunctionBeginUser;
139   PetscCheck((L.h > 0 && R.h > 0), PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Reconstructed thickness is negative");
140   cL = PetscSqrtScalar(g * L.h);
141   cR = PetscSqrtScalar(g * R.h);
142   c  = PetscMax(cL, cR);
143   {
144     /* Solve for star state */
145     const PetscInt maxits = 50;
146     PetscScalar    tmp, res, res0 = 0, h0, h = 0.5 * (L.h + R.h); /* initial guess */
147     h0 = h;
148     for (i = 0; i < maxits; i++) {
149       PetscScalar fr, fl, dfr, dfl;
150       fl  = (L.h < h) ? PetscSqrtScalar(0.5 * g * (h * h - L.h * L.h) * (1 / L.h - 1 / h)) /* shock */
151                       : 2 * PetscSqrtScalar(g * h) - 2 * PetscSqrtScalar(g * L.h);         /* rarefaction */
152       fr  = (R.h < h) ? PetscSqrtScalar(0.5 * g * (h * h - R.h * R.h) * (1 / R.h - 1 / h)) /* shock */
153                       : 2 * PetscSqrtScalar(g * h) - 2 * PetscSqrtScalar(g * R.h);         /* rarefaction */
154       res = R.u - L.u + fr + fl;
155       PetscCheck(!PetscIsInfOrNanScalar(res), PETSC_COMM_SELF, PETSC_ERR_FP, "Infinity or Not-a-Number generated in computation");
156       if (PetscAbsScalar(res) < PETSC_SQRT_MACHINE_EPSILON || (i > 0 && PetscAbsScalar(h - h0) < PETSC_SQRT_MACHINE_EPSILON)) {
157         star.h = h;
158         star.u = L.u - fl;
159         goto converged;
160       } else if (i > 0 && PetscAbsScalar(res) >= PetscAbsScalar(res0)) { /* Line search */
161         h = 0.8 * h0 + 0.2 * h;
162         continue;
163       }
164       /* Accept the last step and take another */
165       res0 = res;
166       h0   = h;
167       dfl  = (L.h < h) ? 0.5 / fl * 0.5 * g * (-L.h * L.h / (h * h) - 1 + 2 * h / L.h) : PetscSqrtScalar(g / h);
168       dfr  = (R.h < h) ? 0.5 / fr * 0.5 * g * (-R.h * R.h / (h * h) - 1 + 2 * h / R.h) : PetscSqrtScalar(g / h);
169       tmp  = h - res / (dfr + dfl);
170       if (tmp <= 0) h /= 2; /* Guard against Newton shooting off to a negative thickness */
171       else h = tmp;
172       PetscCheck(((h > 0) && PetscIsNormalScalar(h)), PETSC_COMM_SELF, PETSC_ERR_FP, "non-normal iterate h=%g", (double)h);
173     }
174     SETERRQ(PETSC_COMM_SELF, 1, "Newton iteration for star.h diverged after %" PetscInt_FMT " iterations", i);
175   }
176 converged:
177   cstar = PetscSqrtScalar(g * star.h);
178   if (L.u - cL < 0 && 0 < star.u - cstar) { /* 1-wave is sonic rarefaction */
179     PetscScalar ufan[2];
180     ufan[0] = 1 / g * PetscSqr(L.u / 3 + 2. / 3 * cL);
181     ufan[1] = PetscSqrtScalar(g * ufan[0]) * ufan[0];
182     ShallowFlux(phys, ufan, flux);
183   } else if (star.u + cstar < 0 && 0 < R.u + cR) { /* 2-wave is sonic rarefaction */
184     PetscScalar ufan[2];
185     ufan[0] = 1 / g * PetscSqr(R.u / 3 - 2. / 3 * cR);
186     ufan[1] = -PetscSqrtScalar(g * ufan[0]) * ufan[0];
187     ShallowFlux(phys, ufan, flux);
188   } else if ((L.h >= star.h && L.u - c >= 0) || (L.h < star.h && (star.h * star.u - L.h * L.u) / (star.h - L.h) > 0)) {
189     /* 1-wave is right-travelling shock (supersonic) */
190     ShallowFlux(phys, uL, flux);
191   } else if ((star.h <= R.h && R.u + c <= 0) || (star.h > R.h && (R.h * R.u - star.h * star.h) / (R.h - star.h) < 0)) {
192     /* 2-wave is left-travelling shock (supersonic) */
193     ShallowFlux(phys, uR, flux);
194   } else {
195     ustar[0] = star.h;
196     ustar[1] = star.h * star.u;
197     ShallowFlux(phys, ustar, flux);
198   }
199   *maxspeed = MaxAbs(MaxAbs(star.u - cstar, star.u + cstar), MaxAbs(L.u - cL, R.u + cR));
200   PetscFunctionReturn(0);
201 }
202 
203 static PetscErrorCode PhysicsRiemann_Shallow_Rusanov(void *vctx, PetscInt m, const PetscScalar *uL, const PetscScalar *uR, PetscScalar *flux, PetscReal *maxspeed) {
204   ShallowCtx *phys = (ShallowCtx *)vctx;
205   PetscScalar g    = phys->gravity, fL[2], fR[2], s;
206   struct {
207     PetscScalar h, u;
208   } L = {uL[0], uL[1] / uL[0]}, R = {uR[0], uR[1] / uR[0]};
209   PetscReal tol = 1e-6;
210 
211   PetscFunctionBeginUser;
212   /* Positivity preserving modification*/
213   if (L.h < tol) L.u = 0.0;
214   if (R.h < tol) R.u = 0.0;
215 
216   /*simple pos preserve limiter*/
217   if (L.h < 0) L.h = 0;
218   if (R.h < 0) R.h = 0;
219 
220   ShallowFlux(phys, uL, fL);
221   ShallowFlux(phys, uR, fR);
222 
223   s         = PetscMax(PetscAbs(L.u) + PetscSqrtScalar(g * L.h), PetscAbs(R.u) + PetscSqrtScalar(g * R.h));
224   flux[0]   = 0.5 * (fL[0] + fR[0]) + 0.5 * s * (L.h - R.h);
225   flux[1]   = 0.5 * (fL[1] + fR[1]) + 0.5 * s * (uL[1] - uR[1]);
226   *maxspeed = s;
227   PetscFunctionReturn(0);
228 }
229 
230 static PetscErrorCode PhysicsCharacteristic_Conservative(void *vctx, PetscInt m, const PetscScalar *u, PetscScalar *X, PetscScalar *Xi, PetscReal *speeds) {
231   PetscInt i, j;
232 
233   PetscFunctionBeginUser;
234   for (i = 0; i < m; i++) {
235     for (j = 0; j < m; j++) Xi[i * m + j] = X[i * m + j] = (PetscScalar)(i == j);
236     speeds[i] = PETSC_MAX_REAL; /* Indicates invalid */
237   }
238   PetscFunctionReturn(0);
239 }
240 
241 static PetscErrorCode PhysicsCharacteristic_Shallow(void *vctx, PetscInt m, const PetscScalar *u, PetscScalar *X, PetscScalar *Xi, PetscReal *speeds) {
242   ShallowCtx *phys = (ShallowCtx *)vctx;
243   PetscReal   c;
244   PetscReal   tol = 1e-6;
245 
246   PetscFunctionBeginUser;
247   c = PetscSqrtScalar(u[0] * phys->gravity);
248 
249   if (u[0] < tol) { /*Use conservative variables*/
250     X[0 * 2 + 0] = 1;
251     X[0 * 2 + 1] = 0;
252     X[1 * 2 + 0] = 0;
253     X[1 * 2 + 1] = 1;
254   } else {
255     speeds[0]    = u[1] / u[0] - c;
256     speeds[1]    = u[1] / u[0] + c;
257     X[0 * 2 + 0] = 1;
258     X[0 * 2 + 1] = speeds[0];
259     X[1 * 2 + 0] = 1;
260     X[1 * 2 + 1] = speeds[1];
261   }
262 
263   PetscCall(PetscArraycpy(Xi, X, 4));
264   PetscCall(PetscKernel_A_gets_inverse_A_2(Xi, 0, PETSC_FALSE, NULL));
265   PetscFunctionReturn(0);
266 }
267 
268 static PetscErrorCode PhysicsSample_Shallow(void *vctx, PetscInt initial, FVBCType bctype, PetscReal xmin, PetscReal xmax, PetscReal t, PetscReal x, PetscReal *u) {
269   PetscFunctionBeginUser;
270   PetscCheck(t <= 0, PETSC_COMM_SELF, PETSC_ERR_SUP, "Exact solutions not implemented for t > 0");
271   switch (initial) {
272   case 0:
273     u[0] = (x < 0) ? 2 : 1; /* Standard Dam Break Problem */
274     u[1] = (x < 0) ? 0 : 0;
275     break;
276   case 1:
277     u[0] = (x < 10) ? 1 : 0.1; /*The Next 5 problems are standard Riemann problem tests */
278     u[1] = (x < 10) ? 2.5 : 0;
279     break;
280   case 2:
281     u[0] = (x < 25) ? 1 : 1;
282     u[1] = (x < 25) ? -5 : 5;
283     break;
284   case 3:
285     u[0] = (x < 20) ? 1 : 1e-12;
286     u[1] = (x < 20) ? 0 : 0;
287     break;
288   case 4:
289     u[0] = (x < 30) ? 1e-12 : 1;
290     u[1] = (x < 30) ? 0 : 0;
291     break;
292   case 5:
293     u[0] = (x < 25) ? 0.1 : 0.1;
294     u[1] = (x < 25) ? -0.3 : 0.3;
295     break;
296   case 6:
297     u[0] = 1 + 0.5 * PetscSinReal(2 * PETSC_PI * x);
298     u[1] = 1 * u[0];
299     break;
300   case 7:
301     if (x < -0.1) {
302       u[0] = 1e-9;
303       u[1] = 0.0;
304     } else if (x < 0.1) {
305       u[0] = 1.0;
306       u[1] = 0.0;
307     } else {
308       u[0] = 1e-9;
309       u[1] = 0.0;
310     }
311     break;
312   case 8:
313     if (x < -0.1) {
314       u[0] = 2;
315       u[1] = 0.0;
316     } else if (x < 0.1) {
317       u[0] = 3.0;
318       u[1] = 0.0;
319     } else {
320       u[0] = 2;
321       u[1] = 0.0;
322     }
323     break;
324   default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "unknown initial condition");
325   }
326   PetscFunctionReturn(0);
327 }
328 
329 /* Implements inflow conditions for the given initial conditions. Which conditions are actually enforced depends on
330    on the results of PhysicsSetInflowType_Shallow. */
331 static PetscErrorCode PhysicsInflow_Shallow(void *vctx, PetscReal t, PetscReal x, PetscReal *u) {
332   FVCtx *ctx = (FVCtx *)vctx;
333 
334   PetscFunctionBeginUser;
335   if (ctx->bctype == FVBC_INFLOW) {
336     switch (ctx->initial) {
337     case 0:
338     case 1:
339     case 2:
340     case 3:
341     case 4:
342     case 5:
343       u[0] = 0;
344       u[1] = 0.0; /* Left boundary conditions */
345       u[2] = 0;
346       u[3] = 0.0; /* Right boundary conditions */
347       break;
348     case 6:
349       u[0] = 0;
350       u[1] = 0.0; /* Left boundary conditions */
351       u[2] = 0;
352       u[3] = 0.0; /* Right boundary conditions */
353       break;
354     case 7:
355       u[0] = 0;
356       u[1] = 0.0; /* Left boundary conditions */
357       u[2] = 0;
358       u[3] = 0.0; /* Right boundary conditions */
359       break;
360     case 8:
361       u[0] = 0;
362       u[1] = 1.0; /* Left boundary conditions */
363       u[2] = 0;
364       u[3] = -1.0; /* Right boundary conditions */
365       break;
366     default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "unknown initial condition");
367     }
368   }
369   PetscFunctionReturn(0);
370 }
371 
372 /* Selects which boundary conditions are marked as inflow and which as outflow when FVBC_INFLOW is selected. */
373 static PetscErrorCode PhysicsSetInflowType_Shallow(FVCtx *ctx) {
374   PetscFunctionBeginUser;
375   switch (ctx->initial) {
376   case 0:
377   case 1:
378   case 2:
379   case 3:
380   case 4:
381   case 5:
382   case 6:
383   case 7:
384   case 8: /* Fix left and right momentum, height is outflow */
385     ctx->physics2.bcinflowindex[0] = PETSC_FALSE;
386     ctx->physics2.bcinflowindex[1] = PETSC_TRUE;
387     ctx->physics2.bcinflowindex[2] = PETSC_FALSE;
388     ctx->physics2.bcinflowindex[3] = PETSC_TRUE;
389     break;
390   default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "unknown initial condition");
391   }
392   PetscFunctionReturn(0);
393 }
394 
395 static PetscErrorCode PhysicsCreate_Shallow(FVCtx *ctx) {
396   ShallowCtx       *user;
397   PetscFunctionList rlist = 0, rclist = 0;
398   char              rname[256] = "rusanov", rcname[256] = "characteristic";
399 
400   PetscFunctionBeginUser;
401   PetscCall(PetscNew(&user));
402   ctx->physics2.sample2         = PhysicsSample_Shallow;
403   ctx->physics2.inflow          = PhysicsInflow_Shallow;
404   ctx->physics2.destroy         = PhysicsDestroy_SimpleFree;
405   ctx->physics2.riemann2        = PhysicsRiemann_Shallow_Rusanov;
406   ctx->physics2.characteristic2 = PhysicsCharacteristic_Shallow;
407   ctx->physics2.user            = user;
408   ctx->physics2.dof             = 2;
409 
410   PetscMalloc1(2 * (ctx->physics2.dof), &ctx->physics2.bcinflowindex);
411   PhysicsSetInflowType_Shallow(ctx);
412 
413   PetscCall(PetscStrallocpy("height", &ctx->physics2.fieldname[0]));
414   PetscCall(PetscStrallocpy("momentum", &ctx->physics2.fieldname[1]));
415 
416   user->gravity = 9.81;
417 
418   PetscCall(RiemannListAdd_2WaySplit(&rlist, "exact", PhysicsRiemann_Shallow_Exact));
419   PetscCall(RiemannListAdd_2WaySplit(&rlist, "rusanov", PhysicsRiemann_Shallow_Rusanov));
420   PetscCall(ReconstructListAdd_2WaySplit(&rclist, "characteristic", PhysicsCharacteristic_Shallow));
421   PetscCall(ReconstructListAdd_2WaySplit(&rclist, "conservative", PhysicsCharacteristic_Conservative));
422   PetscOptionsBegin(ctx->comm, ctx->prefix, "Options for Shallow", "");
423   PetscCall(PetscOptionsReal("-physics_shallow_gravity", "Gravity", "", user->gravity, &user->gravity, NULL));
424   PetscCall(PetscOptionsFList("-physics_shallow_riemann", "Riemann solver", "", rlist, rname, rname, sizeof(rname), NULL));
425   PetscCall(PetscOptionsFList("-physics_shallow_reconstruct", "Reconstruction", "", rclist, rcname, rcname, sizeof(rcname), NULL));
426   PetscOptionsEnd();
427   PetscCall(RiemannListFind_2WaySplit(rlist, rname, &ctx->physics2.riemann2));
428   PetscCall(ReconstructListFind_2WaySplit(rclist, rcname, &ctx->physics2.characteristic2));
429   PetscCall(PetscFunctionListDestroy(&rlist));
430   PetscCall(PetscFunctionListDestroy(&rclist));
431   PetscFunctionReturn(0);
432 }
433 
434 PetscErrorCode FVSample_2WaySplit(FVCtx *ctx, DM da, PetscReal time, Vec U) {
435   PetscScalar   *u, *uj, xj, xi;
436   PetscInt       i, j, k, dof, xs, xm, Mx;
437   const PetscInt N = 200;
438   PetscReal      hs, hf;
439 
440   PetscFunctionBeginUser;
441   PetscCheck(ctx->physics2.sample2, PETSC_COMM_SELF, PETSC_ERR_SUP, "Physics has not provided a sampling function");
442   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0));
443   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
444   PetscCall(DMDAVecGetArray(da, U, &u));
445   PetscCall(PetscMalloc1(dof, &uj));
446   hs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
447   hf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
448   for (i = xs; i < xs + xm; i++) {
449     if (i < ctx->sf) {
450       xi = ctx->xmin + 0.5 * hs + i * hs;
451       /* Integrate over cell i using trapezoid rule with N points. */
452       for (k = 0; k < dof; k++) u[i * dof + k] = 0;
453       for (j = 0; j < N + 1; j++) {
454         xj = xi + hs * (j - N / 2) / (PetscReal)N;
455         PetscCall((*ctx->physics2.sample2)(ctx->physics2.user, ctx->initial, ctx->bctype, ctx->xmin, ctx->xmax, time, xj, uj));
456         for (k = 0; k < dof; k++) u[i * dof + k] += ((j == 0 || j == N) ? 0.5 : 1.0) * uj[k] / N;
457       }
458     } else if (i < ctx->fs) {
459       xi = ctx->xmin + ctx->sf * hs + 0.5 * hf + (i - ctx->sf) * hf;
460       /* Integrate over cell i using trapezoid rule with N points. */
461       for (k = 0; k < dof; k++) u[i * dof + k] = 0;
462       for (j = 0; j < N + 1; j++) {
463         xj = xi + hf * (j - N / 2) / (PetscReal)N;
464         PetscCall((*ctx->physics2.sample2)(ctx->physics2.user, ctx->initial, ctx->bctype, ctx->xmin, ctx->xmax, time, xj, uj));
465         for (k = 0; k < dof; k++) u[i * dof + k] += ((j == 0 || j == N) ? 0.5 : 1.0) * uj[k] / N;
466       }
467     } else {
468       xi = ctx->xmin + ctx->sf * hs + (ctx->fs - ctx->sf) * hf + 0.5 * hs + (i - ctx->fs) * hs;
469       /* Integrate over cell i using trapezoid rule with N points. */
470       for (k = 0; k < dof; k++) u[i * dof + k] = 0;
471       for (j = 0; j < N + 1; j++) {
472         xj = xi + hs * (j - N / 2) / (PetscReal)N;
473         PetscCall((*ctx->physics2.sample2)(ctx->physics2.user, ctx->initial, ctx->bctype, ctx->xmin, ctx->xmax, time, xj, uj));
474         for (k = 0; k < dof; k++) u[i * dof + k] += ((j == 0 || j == N) ? 0.5 : 1.0) * uj[k] / N;
475       }
476     }
477   }
478   PetscCall(DMDAVecRestoreArray(da, U, &u));
479   PetscCall(PetscFree(uj));
480   PetscFunctionReturn(0);
481 }
482 
483 static PetscErrorCode SolutionErrorNorms_2WaySplit(FVCtx *ctx, DM da, PetscReal t, Vec X, PetscReal *nrm1) {
484   Vec                Y;
485   PetscInt           i, Mx;
486   const PetscScalar *ptr_X, *ptr_Y;
487   PetscReal          hs, hf;
488 
489   PetscFunctionBeginUser;
490   PetscCall(VecGetSize(X, &Mx));
491   PetscCall(VecDuplicate(X, &Y));
492   PetscCall(FVSample_2WaySplit(ctx, da, t, Y));
493   hs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
494   hf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
495   PetscCall(VecGetArrayRead(X, &ptr_X));
496   PetscCall(VecGetArrayRead(Y, &ptr_Y));
497   for (i = 0; i < Mx; i++) {
498     if (i < ctx->sf || i > ctx->fs - 1) *nrm1 += hs * PetscAbs(ptr_X[i] - ptr_Y[i]);
499     else *nrm1 += hf * PetscAbs(ptr_X[i] - ptr_Y[i]);
500   }
501   PetscCall(VecRestoreArrayRead(X, &ptr_X));
502   PetscCall(VecRestoreArrayRead(Y, &ptr_Y));
503   PetscCall(VecDestroy(&Y));
504   PetscFunctionReturn(0);
505 }
506 
507 PetscErrorCode FVRHSFunction_2WaySplit(TS ts, PetscReal time, Vec X, Vec F, void *vctx) {
508   FVCtx       *ctx = (FVCtx *)vctx;
509   PetscInt     i, j, k, Mx, dof, xs, xm, sf = ctx->sf, fs = ctx->fs;
510   PetscReal    hxf, hxs, cfl_idt = 0;
511   PetscScalar *x, *f, *slope;
512   Vec          Xloc;
513   DM           da;
514 
515   PetscFunctionBeginUser;
516   PetscCall(TSGetDM(ts, &da));
517   PetscCall(DMGetLocalVector(da, &Xloc));                                 /* Xloc contains ghost points                                     */
518   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0)); /* Mx is the number of center points                              */
519   hxs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
520   hxf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
521   PetscCall(DMGlobalToLocalBegin(da, X, INSERT_VALUES, Xloc)); /* X is solution vector which does not contain ghost points       */
522   PetscCall(DMGlobalToLocalEnd(da, X, INSERT_VALUES, Xloc));
523 
524   PetscCall(VecZeroEntries(F)); /* F is the right hand side function corresponds to center points */
525 
526   PetscCall(DMDAVecGetArray(da, Xloc, &x));
527   PetscCall(DMDAVecGetArray(da, F, &f));
528   PetscCall(DMDAGetArray(da, PETSC_TRUE, &slope)); /* contains ghost points                                           */
529   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
530 
531   if (ctx->bctype == FVBC_OUTFLOW) {
532     for (i = xs - 2; i < 0; i++) {
533       for (j = 0; j < dof; j++) x[i * dof + j] = x[j];
534     }
535     for (i = Mx; i < xs + xm + 2; i++) {
536       for (j = 0; j < dof; j++) x[i * dof + j] = x[(xs + xm - 1) * dof + j];
537     }
538   }
539 
540   if (ctx->bctype == FVBC_INFLOW) {
541     /* See LeVeque, R. (2002). Finite Volume Methods for Hyperbolic Problems. doi:10.1017/CBO9780511791253
542     pages 137-138 for the scheme. */
543     if (xs == 0) { /* Left Boundary */
544       ctx->physics2.inflow(ctx, time, ctx->xmin, ctx->ub);
545       for (j = 0; j < dof; j++) {
546         if (ctx->physics2.bcinflowindex[j]) {
547           for (i = -2; i < 0; i++) x[i * dof + j] = 2.0 * ctx->ub[j] - x[-(i + 1) * dof + j];
548         } else {
549           for (i = -2; i < 0; i++) x[i * dof + j] = x[j]; /* Outflow */
550         }
551       }
552     }
553     if (xs + xm == Mx) { /* Right Boundary */
554       ctx->physics2.inflow(ctx, time, ctx->xmax, ctx->ub);
555       for (j = 0; j < dof; j++) {
556         if (ctx->physics2.bcinflowindex[dof + j]) {
557           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = 2.0 * ctx->ub[dof + j] - x[(2 * Mx - (i + 1)) * dof + j];
558         } else {
559           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = x[(Mx - 1) * dof + j]; /* Outflow */
560         }
561       }
562     }
563   }
564 
565   for (i = xs - 1; i < xs + xm + 1; i++) {
566     struct _LimitInfo info;
567     PetscScalar      *cjmpL, *cjmpR;
568     /* Determine the right eigenvectors R, where A = R \Lambda R^{-1} */
569     PetscCall((*ctx->physics2.characteristic2)(ctx->physics2.user, dof, &x[i * dof], ctx->R, ctx->Rinv, ctx->speeds));
570     /* Evaluate jumps across interfaces (i-1, i) and (i, i+1), put in characteristic basis */
571     PetscCall(PetscArrayzero(ctx->cjmpLR, 2 * dof));
572     cjmpL = &ctx->cjmpLR[0];
573     cjmpR = &ctx->cjmpLR[dof];
574     for (j = 0; j < dof; j++) {
575       PetscScalar jmpL, jmpR;
576       jmpL = x[(i + 0) * dof + j] - x[(i - 1) * dof + j];
577       jmpR = x[(i + 1) * dof + j] - x[(i + 0) * dof + j];
578       for (k = 0; k < dof; k++) {
579         cjmpL[k] += ctx->Rinv[k + j * dof] * jmpL;
580         cjmpR[k] += ctx->Rinv[k + j * dof] * jmpR;
581       }
582     }
583     /* Apply limiter to the left and right characteristic jumps */
584     info.m   = dof;
585     info.hxs = hxs;
586     info.hxf = hxf;
587     (*ctx->limit2)(&info, cjmpL, cjmpR, ctx->sf, ctx->fs, i, ctx->cslope);
588     for (j = 0; j < dof; j++) {
589       PetscScalar tmp = 0;
590       for (k = 0; k < dof; k++) tmp += ctx->R[j + k * dof] * ctx->cslope[k];
591       slope[i * dof + j] = tmp;
592     }
593   }
594 
595   for (i = xs; i < xs + xm + 1; i++) {
596     PetscReal    maxspeed;
597     PetscScalar *uL, *uR;
598     uL = &ctx->uLR[0];
599     uR = &ctx->uLR[dof];
600     if (i < sf) { /* slow region */
601       for (j = 0; j < dof; j++) {
602         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
603         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
604       }
605       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
606       if (i > xs) {
607         for (j = 0; j < dof; j++) f[(i - 1) * dof + j] -= ctx->flux[j] / hxs;
608       }
609       if (i < xs + xm) {
610         for (j = 0; j < dof; j++) f[i * dof + j] += ctx->flux[j] / hxs;
611       }
612     } else if (i == sf) { /* interface between the slow region and the fast region */
613       for (j = 0; j < dof; j++) {
614         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
615         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxf / 2;
616       }
617       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
618       if (i > xs) {
619         for (j = 0; j < dof; j++) f[(i - 1) * dof + j] -= ctx->flux[j] / hxs;
620       }
621       if (i < xs + xm) {
622         for (j = 0; j < dof; j++) f[i * dof + j] += ctx->flux[j] / hxf;
623       }
624     } else if (i > sf && i < fs) { /* fast region */
625       for (j = 0; j < dof; j++) {
626         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxf / 2;
627         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxf / 2;
628       }
629       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
630       if (i > xs) {
631         for (j = 0; j < dof; j++) f[(i - 1) * dof + j] -= ctx->flux[j] / hxf;
632       }
633       if (i < xs + xm) {
634         for (j = 0; j < dof; j++) f[i * dof + j] += ctx->flux[j] / hxf;
635       }
636     } else if (i == fs) { /* interface between the fast region and the slow region */
637       for (j = 0; j < dof; j++) {
638         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxf / 2;
639         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
640       }
641       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
642       if (i > xs) {
643         for (j = 0; j < dof; j++) f[(i - 1) * dof + j] -= ctx->flux[j] / hxf;
644       }
645       if (i < xs + xm) {
646         for (j = 0; j < dof; j++) f[i * dof + j] += ctx->flux[j] / hxs;
647       }
648     } else { /* slow region */
649       for (j = 0; j < dof; j++) {
650         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
651         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
652       }
653       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
654       cfl_idt = PetscMax(cfl_idt, PetscAbsScalar(maxspeed / hxs)); /* Max allowable value of 1/Delta t */
655       if (i > xs) {
656         for (j = 0; j < dof; j++) f[(i - 1) * dof + j] -= ctx->flux[j] / hxs;
657       }
658       if (i < xs + xm) {
659         for (j = 0; j < dof; j++) f[i * dof + j] += ctx->flux[j] / hxs;
660       }
661     }
662   }
663   PetscCall(DMDAVecRestoreArray(da, Xloc, &x));
664   PetscCall(DMDAVecRestoreArray(da, F, &f));
665   PetscCall(DMDARestoreArray(da, PETSC_TRUE, &slope));
666   PetscCall(DMRestoreLocalVector(da, &Xloc));
667   PetscCallMPI(MPI_Allreduce(&cfl_idt, &ctx->cfl_idt, 1, MPIU_SCALAR, MPIU_MAX, PetscObjectComm((PetscObject)da)));
668   if (0) {
669     /* We need to a way to inform the TS of a CFL constraint, this is a debugging fragment */
670     PetscReal dt, tnow;
671     PetscCall(TSGetTimeStep(ts, &dt));
672     PetscCall(TSGetTime(ts, &tnow));
673     if (dt > 0.5 / ctx->cfl_idt) {
674       if (1) {
675         PetscCall(PetscPrintf(ctx->comm, "Stability constraint exceeded at t=%g, dt %g > %g\n", (double)tnow, (double)dt, (double)(0.5 / ctx->cfl_idt)));
676       } else SETERRQ(PETSC_COMM_SELF, 1, "Stability constraint exceeded, %g > %g", (double)dt, (double)(ctx->cfl / ctx->cfl_idt));
677     }
678   }
679   PetscFunctionReturn(0);
680 }
681 
682 /* --------------------------------- Finite Volume Solver for slow components ----------------------------------- */
683 PetscErrorCode FVRHSFunctionslow_2WaySplit(TS ts, PetscReal time, Vec X, Vec F, void *vctx) {
684   FVCtx       *ctx = (FVCtx *)vctx;
685   PetscInt     i, j, k, Mx, dof, xs, xm, islow = 0, sf = ctx->sf, fs = ctx->fs, lsbwidth = ctx->lsbwidth, rsbwidth = ctx->rsbwidth;
686   PetscReal    hxs, hxf, cfl_idt = 0;
687   PetscScalar *x, *f, *slope;
688   Vec          Xloc;
689   DM           da;
690 
691   PetscFunctionBeginUser;
692   PetscCall(TSGetDM(ts, &da));
693   PetscCall(DMGetLocalVector(da, &Xloc));
694   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0));
695   hxs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
696   hxf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
697   PetscCall(DMGlobalToLocalBegin(da, X, INSERT_VALUES, Xloc));
698   PetscCall(DMGlobalToLocalEnd(da, X, INSERT_VALUES, Xloc));
699   PetscCall(VecZeroEntries(F));
700   PetscCall(DMDAVecGetArray(da, Xloc, &x));
701   PetscCall(VecGetArray(F, &f));
702   PetscCall(DMDAGetArray(da, PETSC_TRUE, &slope));
703   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
704 
705   if (ctx->bctype == FVBC_OUTFLOW) {
706     for (i = xs - 2; i < 0; i++) {
707       for (j = 0; j < dof; j++) x[i * dof + j] = x[j];
708     }
709     for (i = Mx; i < xs + xm + 2; i++) {
710       for (j = 0; j < dof; j++) x[i * dof + j] = x[(xs + xm - 1) * dof + j];
711     }
712   }
713   if (ctx->bctype == FVBC_INFLOW) {
714     /* See LeVeque, R. (2002). Finite Volume Methods for Hyperbolic Problems. doi:10.1017/CBO9780511791253
715     pages 137-138 for the scheme. */
716     if (xs == 0) { /* Left Boundary */
717       ctx->physics2.inflow(ctx, time, ctx->xmin, ctx->ub);
718       for (j = 0; j < dof; j++) {
719         if (ctx->physics2.bcinflowindex[j] == PETSC_TRUE) {
720           for (i = -2; i < 0; i++) x[i * dof + j] = 2.0 * ctx->ub[j] - x[-(i + 1) * dof + j];
721         } else {
722           for (i = -2; i < 0; i++) x[i * dof + j] = x[j]; /* Outflow */
723         }
724       }
725     }
726     if (xs + xm == Mx) { /* Right Boundary */
727       ctx->physics2.inflow(ctx, time, ctx->xmax, ctx->ub);
728       for (j = 0; j < dof; j++) {
729         if (ctx->physics2.bcinflowindex[dof + j] == PETSC_TRUE) {
730           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = 2.0 * ctx->ub[dof + j] - x[(2 * Mx - (i + 1)) * dof + j];
731         } else {
732           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = x[(Mx - 1) * dof + j]; /* Outflow */
733         }
734       }
735     }
736   }
737   for (i = xs - 1; i < xs + xm + 1; i++) {
738     struct _LimitInfo info;
739     PetscScalar      *cjmpL, *cjmpR;
740     if (i < sf - lsbwidth + 1 || i > fs + rsbwidth - 2) { /* slow components and the first and last fast components */
741       /* Determine the right eigenvectors R, where A = R \Lambda R^{-1} */
742       PetscCall((*ctx->physics2.characteristic2)(ctx->physics2.user, dof, &x[i * dof], ctx->R, ctx->Rinv, ctx->speeds));
743       /* Evaluate jumps across interfaces (i-1, i) and (i, i+1), put in characteristic basis */
744       PetscCall(PetscArrayzero(ctx->cjmpLR, 2 * dof));
745       cjmpL = &ctx->cjmpLR[0];
746       cjmpR = &ctx->cjmpLR[dof];
747       for (j = 0; j < dof; j++) {
748         PetscScalar jmpL, jmpR;
749         jmpL = x[(i + 0) * dof + j] - x[(i - 1) * dof + j];
750         jmpR = x[(i + 1) * dof + j] - x[(i + 0) * dof + j];
751         for (k = 0; k < dof; k++) {
752           cjmpL[k] += ctx->Rinv[k + j * dof] * jmpL;
753           cjmpR[k] += ctx->Rinv[k + j * dof] * jmpR;
754         }
755       }
756       /* Apply limiter to the left and right characteristic jumps */
757       info.m   = dof;
758       info.hxs = hxs;
759       info.hxf = hxf;
760       (*ctx->limit2)(&info, cjmpL, cjmpR, ctx->sf, ctx->fs, i, ctx->cslope);
761       for (j = 0; j < dof; j++) {
762         PetscScalar tmp = 0;
763         for (k = 0; k < dof; k++) tmp += ctx->R[j + k * dof] * ctx->cslope[k];
764         slope[i * dof + j] = tmp;
765       }
766     }
767   }
768 
769   for (i = xs; i < xs + xm + 1; i++) {
770     PetscReal    maxspeed;
771     PetscScalar *uL, *uR;
772     uL = &ctx->uLR[0];
773     uR = &ctx->uLR[dof];
774     if (i < sf - lsbwidth) { /* slow region */
775       for (j = 0; j < dof; j++) {
776         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
777         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
778       }
779       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
780       cfl_idt = PetscMax(cfl_idt, PetscAbsScalar(maxspeed / hxs)); /* Max allowable value of 1/Delta t */
781       if (i > xs) {
782         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
783       }
784       if (i < xs + xm) {
785         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
786         islow++;
787       }
788     }
789     if (i == sf - lsbwidth) { /* interface between the slow region and the fast region */
790       for (j = 0; j < dof; j++) {
791         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
792         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
793       }
794       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
795       if (i > xs) {
796         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
797       }
798     }
799     if (i == fs + rsbwidth) { /* slow region */
800       for (j = 0; j < dof; j++) {
801         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
802         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
803       }
804       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
805       if (i < xs + xm) {
806         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
807         islow++;
808       }
809     }
810     if (i > fs + rsbwidth) { /* slow region */
811       for (j = 0; j < dof; j++) {
812         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
813         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
814       }
815       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
816       if (i > xs) {
817         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
818       }
819       if (i < xs + xm) {
820         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
821         islow++;
822       }
823     }
824   }
825   PetscCall(DMDAVecRestoreArray(da, Xloc, &x));
826   PetscCall(VecRestoreArray(F, &f));
827   PetscCall(DMDARestoreArray(da, PETSC_TRUE, &slope));
828   PetscCall(DMRestoreLocalVector(da, &Xloc));
829   PetscCallMPI(MPI_Allreduce(&cfl_idt, &ctx->cfl_idt, 1, MPIU_SCALAR, MPIU_MAX, PetscObjectComm((PetscObject)da)));
830   PetscFunctionReturn(0);
831 }
832 
833 PetscErrorCode FVRHSFunctionslowbuffer_2WaySplit(TS ts, PetscReal time, Vec X, Vec F, void *vctx) {
834   FVCtx       *ctx = (FVCtx *)vctx;
835   PetscInt     i, j, k, Mx, dof, xs, xm, islow = 0, sf = ctx->sf, fs = ctx->fs, lsbwidth = ctx->lsbwidth, rsbwidth = ctx->rsbwidth;
836   PetscReal    hxs, hxf;
837   PetscScalar *x, *f, *slope;
838   Vec          Xloc;
839   DM           da;
840 
841   PetscFunctionBeginUser;
842   PetscCall(TSGetDM(ts, &da));
843   PetscCall(DMGetLocalVector(da, &Xloc));
844   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0));
845   hxs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
846   hxf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
847   PetscCall(DMGlobalToLocalBegin(da, X, INSERT_VALUES, Xloc));
848   PetscCall(DMGlobalToLocalEnd(da, X, INSERT_VALUES, Xloc));
849   PetscCall(VecZeroEntries(F));
850   PetscCall(DMDAVecGetArray(da, Xloc, &x));
851   PetscCall(VecGetArray(F, &f));
852   PetscCall(DMDAGetArray(da, PETSC_TRUE, &slope));
853   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
854 
855   if (ctx->bctype == FVBC_OUTFLOW) {
856     for (i = xs - 2; i < 0; i++) {
857       for (j = 0; j < dof; j++) x[i * dof + j] = x[j];
858     }
859     for (i = Mx; i < xs + xm + 2; i++) {
860       for (j = 0; j < dof; j++) x[i * dof + j] = x[(xs + xm - 1) * dof + j];
861     }
862   }
863   if (ctx->bctype == FVBC_INFLOW) {
864     /* See LeVeque, R. (2002). Finite Volume Methods for Hyperbolic Problems. doi:10.1017/CBO9780511791253
865     pages 137-138 for the scheme. */
866     if (xs == 0) { /* Left Boundary */
867       ctx->physics2.inflow(ctx, time, ctx->xmin, ctx->ub);
868       for (j = 0; j < dof; j++) {
869         if (ctx->physics2.bcinflowindex[j] == PETSC_TRUE) {
870           for (i = -2; i < 0; i++) x[i * dof + j] = 2.0 * ctx->ub[j] - x[-(i + 1) * dof + j];
871         } else {
872           for (i = -2; i < 0; i++) x[i * dof + j] = x[j]; /* Outflow */
873         }
874       }
875     }
876     if (xs + xm == Mx) { /* Right Boundary */
877       ctx->physics2.inflow(ctx, time, ctx->xmax, ctx->ub);
878       for (j = 0; j < dof; j++) {
879         if (ctx->physics2.bcinflowindex[dof + j] == PETSC_TRUE) {
880           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = 2.0 * ctx->ub[dof + j] - x[(2 * Mx - (i + 1)) * dof + j];
881         } else {
882           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = x[(Mx - 1) * dof + j]; /* Outflow */
883         }
884       }
885     }
886   }
887   for (i = xs - 1; i < xs + xm + 1; i++) {
888     struct _LimitInfo info;
889     PetscScalar      *cjmpL, *cjmpR;
890     if ((i > sf - lsbwidth - 2 && i < sf + 1) || (i > fs - 2 && i < fs + rsbwidth + 1)) {
891       /* Determine the right eigenvectors R, where A = R \Lambda R^{-1} */
892       PetscCall((*ctx->physics2.characteristic2)(ctx->physics2.user, dof, &x[i * dof], ctx->R, ctx->Rinv, ctx->speeds));
893       /* Evaluate jumps across interfaces (i-1, i) and (i, i+1), put in characteristic basis */
894       PetscCall(PetscArrayzero(ctx->cjmpLR, 2 * dof));
895       cjmpL = &ctx->cjmpLR[0];
896       cjmpR = &ctx->cjmpLR[dof];
897       for (j = 0; j < dof; j++) {
898         PetscScalar jmpL, jmpR;
899         jmpL = x[(i + 0) * dof + j] - x[(i - 1) * dof + j];
900         jmpR = x[(i + 1) * dof + j] - x[(i + 0) * dof + j];
901         for (k = 0; k < dof; k++) {
902           cjmpL[k] += ctx->Rinv[k + j * dof] * jmpL;
903           cjmpR[k] += ctx->Rinv[k + j * dof] * jmpR;
904         }
905       }
906       /* Apply limiter to the left and right characteristic jumps */
907       info.m   = dof;
908       info.hxs = hxs;
909       info.hxf = hxf;
910       (*ctx->limit2)(&info, cjmpL, cjmpR, ctx->sf, ctx->fs, i, ctx->cslope);
911       for (j = 0; j < dof; j++) {
912         PetscScalar tmp = 0;
913         for (k = 0; k < dof; k++) tmp += ctx->R[j + k * dof] * ctx->cslope[k];
914         slope[i * dof + j] = tmp;
915       }
916     }
917   }
918 
919   for (i = xs; i < xs + xm + 1; i++) {
920     PetscReal    maxspeed;
921     PetscScalar *uL, *uR;
922     uL = &ctx->uLR[0];
923     uR = &ctx->uLR[dof];
924     if (i == sf - lsbwidth) {
925       for (j = 0; j < dof; j++) {
926         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
927         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
928       }
929       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
930       if (i < xs + xm) {
931         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
932         islow++;
933       }
934     }
935     if (i > sf - lsbwidth && i < sf) {
936       for (j = 0; j < dof; j++) {
937         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
938         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
939       }
940       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
941       if (i > xs) {
942         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
943       }
944       if (i < xs + xm) {
945         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
946         islow++;
947       }
948     }
949     if (i == sf) { /* interface between the slow region and the fast region */
950       for (j = 0; j < dof; j++) {
951         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
952         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxf / 2;
953       }
954       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
955       if (i > xs) {
956         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
957       }
958     }
959     if (i == fs) { /* interface between the fast region and the slow region */
960       for (j = 0; j < dof; j++) {
961         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxf / 2;
962         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
963       }
964       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
965       if (i < xs + xm) {
966         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
967         islow++;
968       }
969     }
970     if (i > fs && i < fs + rsbwidth) {
971       for (j = 0; j < dof; j++) {
972         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
973         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
974       }
975       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
976       if (i > xs) {
977         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
978       }
979       if (i < xs + xm) {
980         for (j = 0; j < dof; j++) f[islow * dof + j] += ctx->flux[j] / hxs;
981         islow++;
982       }
983     }
984     if (i == fs + rsbwidth) {
985       for (j = 0; j < dof; j++) {
986         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
987         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
988       }
989       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
990       if (i > xs) {
991         for (j = 0; j < dof; j++) f[(islow - 1) * dof + j] -= ctx->flux[j] / hxs;
992       }
993     }
994   }
995   PetscCall(DMDAVecRestoreArray(da, Xloc, &x));
996   PetscCall(VecRestoreArray(F, &f));
997   PetscCall(DMDARestoreArray(da, PETSC_TRUE, &slope));
998   PetscCall(DMRestoreLocalVector(da, &Xloc));
999   PetscFunctionReturn(0);
1000 }
1001 
1002 /* --------------------------------- Finite Volume Solver for fast  parts ----------------------------------- */
1003 PetscErrorCode FVRHSFunctionfast_2WaySplit(TS ts, PetscReal time, Vec X, Vec F, void *vctx) {
1004   FVCtx       *ctx = (FVCtx *)vctx;
1005   PetscInt     i, j, k, Mx, dof, xs, xm, ifast = 0, sf = ctx->sf, fs = ctx->fs;
1006   PetscReal    hxs, hxf;
1007   PetscScalar *x, *f, *slope;
1008   Vec          Xloc;
1009   DM           da;
1010 
1011   PetscFunctionBeginUser;
1012   PetscCall(TSGetDM(ts, &da));
1013   PetscCall(DMGetLocalVector(da, &Xloc));
1014   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0));
1015   hxs = (ctx->xmax - ctx->xmin) * 3.0 / 8.0 / ctx->sf;
1016   hxf = (ctx->xmax - ctx->xmin) / 4.0 / (ctx->fs - ctx->sf);
1017   PetscCall(DMGlobalToLocalBegin(da, X, INSERT_VALUES, Xloc));
1018   PetscCall(DMGlobalToLocalEnd(da, X, INSERT_VALUES, Xloc));
1019   PetscCall(VecZeroEntries(F));
1020   PetscCall(DMDAVecGetArray(da, Xloc, &x));
1021   PetscCall(VecGetArray(F, &f));
1022   PetscCall(DMDAGetArray(da, PETSC_TRUE, &slope));
1023   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
1024 
1025   if (ctx->bctype == FVBC_OUTFLOW) {
1026     for (i = xs - 2; i < 0; i++) {
1027       for (j = 0; j < dof; j++) x[i * dof + j] = x[j];
1028     }
1029     for (i = Mx; i < xs + xm + 2; i++) {
1030       for (j = 0; j < dof; j++) x[i * dof + j] = x[(xs + xm - 1) * dof + j];
1031     }
1032   }
1033   if (ctx->bctype == FVBC_INFLOW) {
1034     /* See LeVeque, R. (2002). Finite Volume Methods for Hyperbolic Problems. doi:10.1017/CBO9780511791253
1035     pages 137-138 for the scheme. */
1036     if (xs == 0) { /* Left Boundary */
1037       ctx->physics2.inflow(ctx, time, ctx->xmin, ctx->ub);
1038       for (j = 0; j < dof; j++) {
1039         if (ctx->physics2.bcinflowindex[j] == PETSC_TRUE) {
1040           for (i = -2; i < 0; i++) x[i * dof + j] = 2.0 * ctx->ub[j] - x[-(i + 1) * dof + j];
1041         } else {
1042           for (i = -2; i < 0; i++) x[i * dof + j] = x[j]; /* Outflow */
1043         }
1044       }
1045     }
1046     if (xs + xm == Mx) { /* Right Boundary */
1047       ctx->physics2.inflow(ctx, time, ctx->xmax, ctx->ub);
1048       for (j = 0; j < dof; j++) {
1049         if (ctx->physics2.bcinflowindex[dof + j] == PETSC_TRUE) {
1050           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = 2.0 * ctx->ub[dof + j] - x[(2 * Mx - (i + 1)) * dof + j];
1051         } else {
1052           for (i = Mx; i < Mx + 2; i++) x[i * dof + j] = x[(Mx - 1) * dof + j]; /* Outflow */
1053         }
1054       }
1055     }
1056   }
1057   for (i = xs - 1; i < xs + xm + 1; i++) {
1058     struct _LimitInfo info;
1059     PetscScalar      *cjmpL, *cjmpR;
1060     if (i > sf - 2 && i < fs + 1) {
1061       PetscCall((*ctx->physics2.characteristic2)(ctx->physics2.user, dof, &x[i * dof], ctx->R, ctx->Rinv, ctx->speeds));
1062       PetscCall(PetscArrayzero(ctx->cjmpLR, 2 * dof));
1063       cjmpL = &ctx->cjmpLR[0];
1064       cjmpR = &ctx->cjmpLR[dof];
1065       for (j = 0; j < dof; j++) {
1066         PetscScalar jmpL, jmpR;
1067         jmpL = x[(i + 0) * dof + j] - x[(i - 1) * dof + j];
1068         jmpR = x[(i + 1) * dof + j] - x[(i + 0) * dof + j];
1069         for (k = 0; k < dof; k++) {
1070           cjmpL[k] += ctx->Rinv[k + j * dof] * jmpL;
1071           cjmpR[k] += ctx->Rinv[k + j * dof] * jmpR;
1072         }
1073       }
1074       /* Apply limiter to the left and right characteristic jumps */
1075       info.m   = dof;
1076       info.hxs = hxs;
1077       info.hxf = hxf;
1078       (*ctx->limit2)(&info, cjmpL, cjmpR, ctx->sf, ctx->fs, i, ctx->cslope);
1079       for (j = 0; j < dof; j++) {
1080         PetscScalar tmp = 0;
1081         for (k = 0; k < dof; k++) tmp += ctx->R[j + k * dof] * ctx->cslope[k];
1082         slope[i * dof + j] = tmp;
1083       }
1084     }
1085   }
1086 
1087   for (i = xs; i < xs + xm + 1; i++) {
1088     PetscReal    maxspeed;
1089     PetscScalar *uL, *uR;
1090     uL = &ctx->uLR[0];
1091     uR = &ctx->uLR[dof];
1092     if (i == sf) { /* interface between the slow region and the fast region */
1093       for (j = 0; j < dof; j++) {
1094         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxs / 2;
1095         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxf / 2;
1096       }
1097       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
1098       if (i < xs + xm) {
1099         for (j = 0; j < dof; j++) f[ifast * dof + j] += ctx->flux[j] / hxf;
1100         ifast++;
1101       }
1102     }
1103     if (i > sf && i < fs) { /* fast region */
1104       for (j = 0; j < dof; j++) {
1105         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxf / 2;
1106         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxf / 2;
1107       }
1108       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
1109       if (i > xs) {
1110         for (j = 0; j < dof; j++) f[(ifast - 1) * dof + j] -= ctx->flux[j] / hxf;
1111       }
1112       if (i < xs + xm) {
1113         for (j = 0; j < dof; j++) f[ifast * dof + j] += ctx->flux[j] / hxf;
1114         ifast++;
1115       }
1116     }
1117     if (i == fs) { /* interface between the fast region and the slow region */
1118       for (j = 0; j < dof; j++) {
1119         uL[j] = x[(i - 1) * dof + j] + slope[(i - 1) * dof + j] * hxf / 2;
1120         uR[j] = x[(i - 0) * dof + j] - slope[(i - 0) * dof + j] * hxs / 2;
1121       }
1122       PetscCall((*ctx->physics2.riemann2)(ctx->physics2.user, dof, uL, uR, ctx->flux, &maxspeed));
1123       if (i > xs) {
1124         for (j = 0; j < dof; j++) f[(ifast - 1) * dof + j] -= ctx->flux[j] / hxf;
1125       }
1126     }
1127   }
1128   PetscCall(DMDAVecRestoreArray(da, Xloc, &x));
1129   PetscCall(VecRestoreArray(F, &f));
1130   PetscCall(DMDARestoreArray(da, PETSC_TRUE, &slope));
1131   PetscCall(DMRestoreLocalVector(da, &Xloc));
1132   PetscFunctionReturn(0);
1133 }
1134 
1135 int main(int argc, char *argv[]) {
1136   char              lname[256] = "mc", physname[256] = "advect", final_fname[256] = "solution.m";
1137   PetscFunctionList limiters = 0, physics = 0;
1138   MPI_Comm          comm;
1139   TS                ts;
1140   DM                da;
1141   Vec               X, X0, R;
1142   FVCtx             ctx;
1143   PetscInt          i, k, dof, xs, xm, Mx, draw = 0, count_slow, count_fast, islow = 0, ifast = 0, islowbuffer = 0, *index_slow, *index_fast, *index_slowbuffer;
1144   PetscBool         view_final = PETSC_FALSE;
1145   PetscReal         ptime, maxtime;
1146 
1147   PetscFunctionBeginUser;
1148   PetscCall(PetscInitialize(&argc, &argv, 0, help));
1149   comm = PETSC_COMM_WORLD;
1150   PetscCall(PetscMemzero(&ctx, sizeof(ctx)));
1151 
1152   /* Register limiters to be available on the command line */
1153   PetscCall(PetscFunctionListAdd(&limiters, "upwind", Limit2_Upwind));
1154   PetscCall(PetscFunctionListAdd(&limiters, "lax-wendroff", Limit2_LaxWendroff));
1155   PetscCall(PetscFunctionListAdd(&limiters, "beam-warming", Limit2_BeamWarming));
1156   PetscCall(PetscFunctionListAdd(&limiters, "fromm", Limit2_Fromm));
1157   PetscCall(PetscFunctionListAdd(&limiters, "minmod", Limit2_Minmod));
1158   PetscCall(PetscFunctionListAdd(&limiters, "superbee", Limit2_Superbee));
1159   PetscCall(PetscFunctionListAdd(&limiters, "mc", Limit2_MC));
1160   PetscCall(PetscFunctionListAdd(&limiters, "koren3", Limit2_Koren3));
1161 
1162   /* Register physical models to be available on the command line */
1163   PetscCall(PetscFunctionListAdd(&physics, "shallow", PhysicsCreate_Shallow));
1164   PetscCall(PetscFunctionListAdd(&physics, "advect", PhysicsCreate_Advect));
1165 
1166   ctx.comm       = comm;
1167   ctx.cfl        = 0.9;
1168   ctx.bctype     = FVBC_PERIODIC;
1169   ctx.xmin       = -1.0;
1170   ctx.xmax       = 1.0;
1171   ctx.initial    = 1;
1172   ctx.hratio     = 2;
1173   maxtime        = 10.0;
1174   ctx.simulation = PETSC_FALSE;
1175   PetscOptionsBegin(comm, NULL, "Finite Volume solver options", "");
1176   PetscCall(PetscOptionsReal("-xmin", "X min", "", ctx.xmin, &ctx.xmin, NULL));
1177   PetscCall(PetscOptionsReal("-xmax", "X max", "", ctx.xmax, &ctx.xmax, NULL));
1178   PetscCall(PetscOptionsFList("-limit", "Name of flux imiter to use", "", limiters, lname, lname, sizeof(lname), NULL));
1179   PetscCall(PetscOptionsFList("-physics", "Name of physics model to use", "", physics, physname, physname, sizeof(physname), NULL));
1180   PetscCall(PetscOptionsInt("-draw", "Draw solution vector, bitwise OR of (1=initial,2=final,4=final error)", "", draw, &draw, NULL));
1181   PetscCall(PetscOptionsString("-view_final", "Write final solution in ASCII MATLAB format to given file name", "", final_fname, final_fname, sizeof(final_fname), &view_final));
1182   PetscCall(PetscOptionsInt("-initial", "Initial condition (depends on the physics)", "", ctx.initial, &ctx.initial, NULL));
1183   PetscCall(PetscOptionsBool("-exact", "Compare errors with exact solution", "", ctx.exact, &ctx.exact, NULL));
1184   PetscCall(PetscOptionsBool("-simulation", "Compare errors with reference solution", "", ctx.simulation, &ctx.simulation, NULL));
1185   PetscCall(PetscOptionsReal("-cfl", "CFL number to time step at", "", ctx.cfl, &ctx.cfl, NULL));
1186   PetscCall(PetscOptionsEnum("-bc_type", "Boundary condition", "", FVBCTypes, (PetscEnum)ctx.bctype, (PetscEnum *)&ctx.bctype, NULL));
1187   PetscCall(PetscOptionsInt("-hratio", "Spacing ratio", "", ctx.hratio, &ctx.hratio, NULL));
1188   PetscOptionsEnd();
1189 
1190   /* Choose the limiter from the list of registered limiters */
1191   PetscCall(PetscFunctionListFind(limiters, lname, &ctx.limit2));
1192   PetscCheck(ctx.limit2, PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "Limiter '%s' not found", lname);
1193 
1194   /* Choose the physics from the list of registered models */
1195   {
1196     PetscErrorCode (*r)(FVCtx *);
1197     PetscCall(PetscFunctionListFind(physics, physname, &r));
1198     PetscCheck(r, PETSC_COMM_SELF, PETSC_ERR_ARG_UNKNOWN_TYPE, "Physics '%s' not found", physname);
1199     /* Create the physics, will set the number of fields and their names */
1200     PetscCall((*r)(&ctx));
1201   }
1202 
1203   /* Create a DMDA to manage the parallel grid */
1204   PetscCall(DMDACreate1d(comm, DM_BOUNDARY_PERIODIC, 50, ctx.physics2.dof, 2, NULL, &da));
1205   PetscCall(DMSetFromOptions(da));
1206   PetscCall(DMSetUp(da));
1207   /* Inform the DMDA of the field names provided by the physics. */
1208   /* The names will be shown in the title bars when run with -ts_monitor_draw_solution */
1209   for (i = 0; i < ctx.physics2.dof; i++) PetscCall(DMDASetFieldName(da, i, ctx.physics2.fieldname[i]));
1210   PetscCall(DMDAGetInfo(da, 0, &Mx, 0, 0, 0, 0, 0, &dof, 0, 0, 0, 0, 0));
1211   PetscCall(DMDAGetCorners(da, &xs, 0, 0, &xm, 0, 0));
1212 
1213   /* Set coordinates of cell centers */
1214   PetscCall(DMDASetUniformCoordinates(da, ctx.xmin + 0.5 * (ctx.xmax - ctx.xmin) / Mx, ctx.xmax + 0.5 * (ctx.xmax - ctx.xmin) / Mx, 0, 0, 0, 0));
1215 
1216   /* Allocate work space for the Finite Volume solver (so it doesn't have to be reallocated on each function evaluation) */
1217   PetscCall(PetscMalloc4(dof * dof, &ctx.R, dof * dof, &ctx.Rinv, 2 * dof, &ctx.cjmpLR, 1 * dof, &ctx.cslope));
1218   PetscCall(PetscMalloc3(2 * dof, &ctx.uLR, dof, &ctx.flux, dof, &ctx.speeds));
1219   PetscCall(PetscMalloc1(2 * dof, &ctx.ub));
1220 
1221   /* Create a vector to store the solution and to save the initial state */
1222   PetscCall(DMCreateGlobalVector(da, &X));
1223   PetscCall(VecDuplicate(X, &X0));
1224   PetscCall(VecDuplicate(X, &R));
1225 
1226   /* create index for slow parts and fast parts,
1227      count_slow + count_fast = Mx, counts_slow*hs = 0.5, counts_fast*hf = 0.5 */
1228   count_slow = Mx / (1.0 + ctx.hratio / 3.0);
1229   PetscCheck(count_slow % 2 == 0, PETSC_COMM_WORLD, PETSC_ERR_USER, "Please adjust grid size Mx (-da_grid_x) and hratio (-hratio) so that Mx/(1+hratio/3) is even");
1230   count_fast = Mx - count_slow;
1231   ctx.sf     = count_slow / 2;
1232   ctx.fs     = ctx.sf + count_fast;
1233   PetscCall(PetscMalloc1(xm * dof, &index_slow));
1234   PetscCall(PetscMalloc1(xm * dof, &index_fast));
1235   PetscCall(PetscMalloc1(8 * dof, &index_slowbuffer));
1236   ctx.lsbwidth = 4;
1237   ctx.rsbwidth = 4;
1238 
1239   for (i = xs; i < xs + xm; i++) {
1240     if (i < ctx.sf - ctx.lsbwidth || i > ctx.fs + ctx.rsbwidth - 1)
1241       for (k = 0; k < dof; k++) index_slow[islow++] = i * dof + k;
1242     else if ((i >= ctx.sf - ctx.lsbwidth && i < ctx.sf) || (i > ctx.fs - 1 && i <= ctx.fs + ctx.rsbwidth - 1))
1243       for (k = 0; k < dof; k++) index_slowbuffer[islowbuffer++] = i * dof + k;
1244     else
1245       for (k = 0; k < dof; k++) index_fast[ifast++] = i * dof + k;
1246   }
1247   PetscCall(ISCreateGeneral(PETSC_COMM_WORLD, islow, index_slow, PETSC_COPY_VALUES, &ctx.iss));
1248   PetscCall(ISCreateGeneral(PETSC_COMM_WORLD, ifast, index_fast, PETSC_COPY_VALUES, &ctx.isf));
1249   PetscCall(ISCreateGeneral(PETSC_COMM_WORLD, islowbuffer, index_slowbuffer, PETSC_COPY_VALUES, &ctx.issb));
1250 
1251   /* Create a time-stepping object */
1252   PetscCall(TSCreate(comm, &ts));
1253   PetscCall(TSSetDM(ts, da));
1254   PetscCall(TSSetRHSFunction(ts, R, FVRHSFunction_2WaySplit, &ctx));
1255   PetscCall(TSRHSSplitSetIS(ts, "slow", ctx.iss));
1256   PetscCall(TSRHSSplitSetIS(ts, "slowbuffer", ctx.issb));
1257   PetscCall(TSRHSSplitSetIS(ts, "fast", ctx.isf));
1258   PetscCall(TSRHSSplitSetRHSFunction(ts, "slow", NULL, FVRHSFunctionslow_2WaySplit, &ctx));
1259   PetscCall(TSRHSSplitSetRHSFunction(ts, "fast", NULL, FVRHSFunctionfast_2WaySplit, &ctx));
1260   PetscCall(TSRHSSplitSetRHSFunction(ts, "slowbuffer", NULL, FVRHSFunctionslowbuffer_2WaySplit, &ctx));
1261 
1262   PetscCall(TSSetType(ts, TSMPRK));
1263   PetscCall(TSSetMaxTime(ts, maxtime));
1264   PetscCall(TSSetExactFinalTime(ts, TS_EXACTFINALTIME_STEPOVER));
1265 
1266   /* Compute initial conditions and starting time step */
1267   PetscCall(FVSample_2WaySplit(&ctx, da, 0, X0));
1268   PetscCall(FVRHSFunction_2WaySplit(ts, 0, X0, X, (void *)&ctx)); /* Initial function evaluation, only used to determine max speed */
1269   PetscCall(VecCopy(X0, X));                                      /* The function value was not used so we set X=X0 again */
1270   PetscCall(TSSetTimeStep(ts, ctx.cfl / ctx.cfl_idt));
1271   PetscCall(TSSetFromOptions(ts)); /* Take runtime options */
1272   PetscCall(SolutionStatsView(da, X, PETSC_VIEWER_STDOUT_WORLD));
1273   {
1274     PetscInt           steps;
1275     PetscScalar        mass_initial, mass_final, mass_difference, mass_differenceg;
1276     const PetscScalar *ptr_X, *ptr_X0;
1277     const PetscReal    hs = (ctx.xmax - ctx.xmin) * 3.0 / 4.0 / count_slow;
1278     const PetscReal    hf = (ctx.xmax - ctx.xmin) / 4.0 / count_fast;
1279 
1280     PetscCall(TSSolve(ts, X));
1281     PetscCall(TSGetSolveTime(ts, &ptime));
1282     PetscCall(TSGetStepNumber(ts, &steps));
1283     /* calculate the total mass at initial time and final time */
1284     mass_initial = 0.0;
1285     mass_final   = 0.0;
1286     PetscCall(DMDAVecGetArrayRead(da, X0, (void *)&ptr_X0));
1287     PetscCall(DMDAVecGetArrayRead(da, X, (void *)&ptr_X));
1288     for (i = xs; i < xs + xm; i++) {
1289       if (i < ctx.sf || i > ctx.fs - 1) {
1290         for (k = 0; k < dof; k++) {
1291           mass_initial = mass_initial + hs * ptr_X0[i * dof + k];
1292           mass_final   = mass_final + hs * ptr_X[i * dof + k];
1293         }
1294       } else {
1295         for (k = 0; k < dof; k++) {
1296           mass_initial = mass_initial + hf * ptr_X0[i * dof + k];
1297           mass_final   = mass_final + hf * ptr_X[i * dof + k];
1298         }
1299       }
1300     }
1301     PetscCall(DMDAVecRestoreArrayRead(da, X0, (void *)&ptr_X0));
1302     PetscCall(DMDAVecRestoreArrayRead(da, X, (void *)&ptr_X));
1303     mass_difference = mass_final - mass_initial;
1304     PetscCallMPI(MPI_Allreduce(&mass_difference, &mass_differenceg, 1, MPIU_SCALAR, MPIU_SUM, comm));
1305     PetscCall(PetscPrintf(comm, "Mass difference %g\n", (double)mass_differenceg));
1306     PetscCall(PetscPrintf(comm, "Final time %g, steps %" PetscInt_FMT "\n", (double)ptime, steps));
1307     PetscCall(PetscPrintf(comm, "Maximum allowable stepsize according to CFL %g\n", (double)(1.0 / ctx.cfl_idt)));
1308     if (ctx.exact) {
1309       PetscReal nrm1 = 0;
1310       PetscCall(SolutionErrorNorms_2WaySplit(&ctx, da, ptime, X, &nrm1));
1311       PetscCall(PetscPrintf(comm, "Error ||x-x_e||_1 %g\n", (double)nrm1));
1312     }
1313     if (ctx.simulation) {
1314       PetscReal          nrm1 = 0;
1315       PetscViewer        fd;
1316       char               filename[PETSC_MAX_PATH_LEN] = "binaryoutput";
1317       Vec                XR;
1318       PetscBool          flg;
1319       const PetscScalar *ptr_XR;
1320       PetscCall(PetscOptionsGetString(NULL, NULL, "-f", filename, sizeof(filename), &flg));
1321       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_USER, "Must indicate binary file with the -f option");
1322       PetscCall(PetscViewerBinaryOpen(PETSC_COMM_WORLD, filename, FILE_MODE_READ, &fd));
1323       PetscCall(VecDuplicate(X0, &XR));
1324       PetscCall(VecLoad(XR, fd));
1325       PetscCall(PetscViewerDestroy(&fd));
1326       PetscCall(VecGetArrayRead(X, &ptr_X));
1327       PetscCall(VecGetArrayRead(XR, &ptr_XR));
1328       for (i = xs; i < xs + xm; i++) {
1329         if (i < ctx.sf || i > ctx.fs - 1)
1330           for (k = 0; k < dof; k++) nrm1 = nrm1 + hs * PetscAbs(ptr_X[i * dof + k] - ptr_XR[i * dof + k]);
1331         else
1332           for (k = 0; k < dof; k++) nrm1 = nrm1 + hf * PetscAbs(ptr_X[i * dof + k] - ptr_XR[i * dof + k]);
1333       }
1334       PetscCall(VecRestoreArrayRead(X, &ptr_X));
1335       PetscCall(VecRestoreArrayRead(XR, &ptr_XR));
1336       PetscCall(PetscPrintf(comm, "Error ||x-x_e||_1 %g\n", (double)nrm1));
1337       PetscCall(VecDestroy(&XR));
1338     }
1339   }
1340 
1341   PetscCall(SolutionStatsView(da, X, PETSC_VIEWER_STDOUT_WORLD));
1342   if (draw & 0x1) PetscCall(VecView(X0, PETSC_VIEWER_DRAW_WORLD));
1343   if (draw & 0x2) PetscCall(VecView(X, PETSC_VIEWER_DRAW_WORLD));
1344   if (draw & 0x4) {
1345     Vec Y;
1346     PetscCall(VecDuplicate(X, &Y));
1347     PetscCall(FVSample_2WaySplit(&ctx, da, ptime, Y));
1348     PetscCall(VecAYPX(Y, -1, X));
1349     PetscCall(VecView(Y, PETSC_VIEWER_DRAW_WORLD));
1350     PetscCall(VecDestroy(&Y));
1351   }
1352 
1353   if (view_final) {
1354     PetscViewer viewer;
1355     PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD, final_fname, &viewer));
1356     PetscCall(PetscViewerPushFormat(viewer, PETSC_VIEWER_ASCII_MATLAB));
1357     PetscCall(VecView(X, viewer));
1358     PetscCall(PetscViewerPopFormat(viewer));
1359     PetscCall(PetscViewerDestroy(&viewer));
1360   }
1361 
1362   /* Clean up */
1363   PetscCall((*ctx.physics2.destroy)(ctx.physics2.user));
1364   for (i = 0; i < ctx.physics2.dof; i++) PetscCall(PetscFree(ctx.physics2.fieldname[i]));
1365   PetscCall(PetscFree(ctx.physics2.bcinflowindex));
1366   PetscCall(PetscFree(ctx.ub));
1367   PetscCall(PetscFree4(ctx.R, ctx.Rinv, ctx.cjmpLR, ctx.cslope));
1368   PetscCall(PetscFree3(ctx.uLR, ctx.flux, ctx.speeds));
1369   PetscCall(VecDestroy(&X));
1370   PetscCall(VecDestroy(&X0));
1371   PetscCall(VecDestroy(&R));
1372   PetscCall(DMDestroy(&da));
1373   PetscCall(TSDestroy(&ts));
1374   PetscCall(ISDestroy(&ctx.iss));
1375   PetscCall(ISDestroy(&ctx.isf));
1376   PetscCall(ISDestroy(&ctx.issb));
1377   PetscCall(PetscFree(index_slow));
1378   PetscCall(PetscFree(index_fast));
1379   PetscCall(PetscFree(index_slowbuffer));
1380   PetscCall(PetscFunctionListDestroy(&limiters));
1381   PetscCall(PetscFunctionListDestroy(&physics));
1382   PetscCall(PetscFinalize());
1383   return 0;
1384 }
1385 
1386 /*TEST
1387 
1388     build:
1389       requires: !complex !single
1390       depends: finitevolume1d.c
1391 
1392     test:
1393       suffix: 1
1394       args: -da_grid_x 60 -initial 7 -xmin -1 -xmax 1 -hratio 2 -limit mc -ts_dt 0.025 -ts_max_steps 24 -ts_type mprk -ts_mprk_type 2a22
1395       output_file: output/ex4_1.out
1396 
1397     test:
1398       suffix: 2
1399       args: -da_grid_x 60 -initial 7 -xmin -1 -xmax 1 -hratio 2 -limit mc -ts_dt 0.025 -ts_max_steps 24 -ts_type mprk -ts_mprk_type 2a22 -ts_use_splitrhsfunction 1
1400       output_file: output/ex4_1.out
1401 
1402     test:
1403       suffix: 3
1404       args: -da_grid_x 40 -initial 1 -hratio 2 -limit mc -ts_dt 0.1 -ts_max_steps 24 -ts_max_time 7.0 -ts_type mprk -ts_mprk_type 2a22 -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 0
1405       output_file: output/ex4_3.out
1406 
1407     test:
1408       suffix: 4
1409       nsize: 2
1410       args: -da_grid_x 40 -initial 1 -hratio 2 -limit mc -ts_dt 0.1 -ts_max_steps 24 -ts_max_time 7.0 -ts_type mprk -ts_mprk_type 2a22 -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 1
1411       output_file: output/ex4_3.out
1412 
1413     test:
1414       suffix: 5
1415       nsize: 4
1416       args: -da_grid_x 40 -initial 1 -hratio 2 -limit mc -ts_dt 0.1 -ts_max_steps 24 -ts_max_time 7.0 -ts_type mprk -ts_mprk_type 2a22 -physics shallow -bc_type outflow -xmin 0 -xmax 50 -ts_use_splitrhsfunction 1
1417       output_file: output/ex4_3.out
1418 TEST*/
1419