File: ark_reaction_diffusion_mri.c

package info (click to toggle)
sundials 6.4.1%2Bdfsg1-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 79,368 kB
  • sloc: ansic: 218,700; f90: 62,503; cpp: 61,511; fortran: 5,166; python: 4,642; sh: 4,114; makefile: 562; perl: 123
file content (384 lines) | stat: -rw-r--r-- 13,080 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
/* ------------------------------------------------------------------
 * Programmer(s): David J. Gardner @ LLNL
 * ------------------------------------------------------------------
 * Based an example program by Rujeko Chinomona @ SMU.
 * ------------------------------------------------------------------
 * SUNDIALS Copyright Start
 * Copyright (c) 2002-2022, Lawrence Livermore National Security
 * and Southern Methodist University.
 * All rights reserved.
 *
 * See the top-level LICENSE and NOTICE files for details.
 *
 * SPDX-License-Identifier: BSD-3-Clause
 * SUNDIALS Copyright End
 * ------------------------------------------------------------------
 * Example problem:
 *
 * The following test simulates a simple 1D reaction-diffusion
 * equation,
 *
 *   y_t = k * y_xx + y^2 * (1-y)
 *
 * for t in [0, 3], x in [0, L] with boundary conditions,
 *
 *   y_x(0,t) = y_x(L,t) = 0
 *
 * and initial condition,
 *
 *   y(x,0) = (1 + exp(lambda*(x-1))^(-1),
 *
 * with parameter k = 1e-4/ep, lambda = 0.5*sqrt(2*ep*1e4),
 * ep = 1e-2, and L = 5.
 *
 * The spatial derivatives are computed using second-order
 * centered differences, with the data distributed over N points
 * on a uniform spatial grid.
 *
 * This program solves the problem with the MRI stepper. Outputs are
 * printed at equal intervals of 0.1 and run statistics are printed
 * at the end.
 * ----------------------------------------------------------------*/

/* Header files */
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <arkode/arkode_mristep.h>    /* prototypes for MRIStep fcts., consts */
#include <arkode/arkode_arkstep.h>    /* prototypes for ARKStep fcts., consts */
#include <nvector/nvector_serial.h>   /* serial N_Vector types, fcts., macros */
#include <sundials/sundials_types.h>  /* defs. of realtype, sunindextype, etc */

#if defined(SUNDIALS_EXTENDED_PRECISION)
#define GSYM "Lg"
#define ESYM "Le"
#define FSYM "Lf"
#else
#define GSYM "g"
#define ESYM "e"
#define FSYM "f"
#endif

/* user data structure */
typedef struct {
  sunindextype N;  /* number of intervals   */
  realtype dx;     /* mesh spacing          */
  realtype k;      /* diffusion coefficient */
  realtype lam;
} *UserData;

/* User-supplied Functions Called by the Solver */
static int fs(realtype t, N_Vector y, N_Vector ydot, void *user_data);
static int ff(realtype t, N_Vector y, N_Vector ydot, void *user_data);

/* Private function to set initial condition */
static int SetInitialCondition(N_Vector y, UserData udata);

/* Private function to check function return values */
static int check_retval(void *returnvalue, const char *funcname, int opt);

/* Main Program */
int main() {

  /* general problem parameters */
  realtype T0 = RCONST(0.0);     /* initial time */
  realtype Tf = RCONST(3.0);     /* final time */
  realtype dTout = RCONST(0.1);  /* time between outputs */
  int Nt = (int) ceil(Tf/dTout); /* number of output times */
  realtype hs = RCONST(0.001);   /* slow step size */
  realtype hf = RCONST(0.00002); /* fast step size */
  UserData udata = NULL;         /* user data */

  realtype *data;                /* array for solution output */
  realtype L = RCONST(5.0);      /* domain length */
  sunindextype N = 1001;         /* number of mesh points */
  realtype ep = RCONST(1e-2);
  sunindextype i;

  /* general problem variables */
  int retval;                               /* reusable error-checking flag */
  N_Vector y = NULL;                        /* empty vector for storing solution */
  void *arkode_mem = NULL;                  /* empty ARKode memory structure */
  void *inner_arkode_mem = NULL;            /* empty ARKode memory structure */
  MRIStepInnerStepper inner_stepper = NULL; /* inner stepper */
  FILE *FID, *UFID;
  realtype t, tout;
  int iout;

  /* Create the SUNDIALS context object for this simulation */
  SUNContext ctx;
  retval = SUNContext_Create(NULL, &ctx);
  if (check_retval(&retval, "SUNContext_Create", 1)) return 1;

  /*
   * Initialization
   */

  /* allocate and fill user data structure */
  udata = (UserData) malloc(sizeof(*udata));
  udata->N   = N;
  udata->dx  = L / (RCONST(1.0)*N - RCONST(1.0));
  udata->k   = RCONST(1e-4)/ep;
  udata->lam = RCONST(0.5)*sqrt(RCONST(2.0) * ep * RCONST(1e4));

  /* Initial problem output */
  printf("\n1D reaction-diffusion PDE test problem:\n");
  printf("  N = %li\n", (long int) udata->N);
  printf("  diffusion coefficient:  k = %"GSYM"\n", udata->k);

  /* Create and initialize serial vector for the solution */
  y = N_VNew_Serial(N, ctx);
  if (check_retval((void *) y, "N_VNew_Serial", 0)) return 1;

  retval = SetInitialCondition(y, udata);
  if (check_retval(&retval, "SetInitialCondition", 1)) return 1;

  /*
   * Create the slow integrator and set options
   */

  /* Initialize the fast integrator. Specify the explicit fast right-hand side
     function in y'=fe(t,y)+fi(t,y)+ff(t,y), the inital time T0, and the
     initial dependent variable vector y. */
  inner_arkode_mem = ARKStepCreate(ff, NULL, T0, y, ctx);
  if (check_retval((void *) inner_arkode_mem, "ARKStepCreate", 0)) return 1;

  /* Attach user data to fast integrator */
  retval = ARKStepSetUserData(inner_arkode_mem, (void *) udata);
  if (check_retval(&retval, "ARKStepSetUserData", 1)) return 1;

  /* Set the fast method */
  retval = ARKStepSetTableNum(inner_arkode_mem, -1, ARKODE_KNOTH_WOLKE_3_3);
  if (check_retval(&retval, "ARKStepSetTableNum", 1)) return 1;

  /* Set the fast step size */
  retval = ARKStepSetFixedStep(inner_arkode_mem, hf);
  if (check_retval(&retval, "ARKStepSetFixedStep", 1)) return 1;

  /* Create inner stepper */
  retval = ARKStepCreateMRIStepInnerStepper(inner_arkode_mem,
                                            &inner_stepper);
  if (check_retval(&retval, "ARKStepCreateMRIStepInnerStepper", 1)) return 1;

  /*
   * Create the slow integrator and set options
   */

  /* Initialize the slow integrator. Specify the explicit slow right-hand side
     function in y'=fe(t,y)+fi(t,y)+ff(t,y), the inital time T0, the
     initial dependent variable vector y, and the fast integrator. */
  arkode_mem = MRIStepCreate(fs, NULL, T0, y, inner_stepper, ctx);
  if (check_retval((void *) arkode_mem, "MRIStepCreate", 0)) return 1;

  /* Pass udata to user functions */
  retval = MRIStepSetUserData(arkode_mem, (void *) udata);
  if (check_retval(&retval, "MRIStepSetUserData", 1)) return 1;

  /* Set the slow step size */
  retval = MRIStepSetFixedStep(arkode_mem, hs);
  if (check_retval(&retval, "MRIStepSetFixedStep", 1)) return 1;

  /* Increase max num steps  */
  retval = MRIStepSetMaxNumSteps(arkode_mem, 10000);
  if (check_retval(&retval, "MRIStepSetMaxNumSteps", 1)) return 1;

  /*
   * Integrate ODE
   */

  /* output mesh to disk */
  FID=fopen("heat_mesh.txt","w");
  for (i=0; i<N; i++)  fprintf(FID,"  %.16"ESYM"\n", udata->dx*i);
  fclose(FID);

  /* Open output stream for results, access data array */
  UFID=fopen("heat1D.txt","w");
  data = N_VGetArrayPointer(y);

  /* output initial condition to disk */
  for (i=0; i<N; i++)  fprintf(UFID," %.16"ESYM"", data[i]);
  fprintf(UFID,"\n");

  /* Main time-stepping loop: calls MRIStepEvolve to perform the integration, then
     prints results. Stops when the final time has been reached */
  t = T0;
  dTout = (Tf-T0)/Nt;
  tout = T0+dTout;
  printf("        t      ||u||_rms\n");
  printf("   -------------------------\n");
  printf("  %10.6"FSYM"  %10.6f\n", t, sqrt(N_VDotProd(y,y)/N));
  for (iout=0; iout<Nt; iout++) {

    /* call integrator */
    retval = MRIStepEvolve(arkode_mem, tout, y, &t, ARK_NORMAL);
    if (check_retval(&retval, "MRIStepEvolve", 1)) break;

    /* print solution stats and output results to disk */
    printf("  %10.6"FSYM"  %10.6f\n", t, sqrt(N_VDotProd(y,y)/N));
    for (i=0; i<N; i++)  fprintf(UFID," %.16"ESYM"", data[i]);
    fprintf(UFID,"\n");

    /* successful solve: update output time */
    tout += dTout;
    tout = (tout > Tf) ? Tf : tout;
  }
  printf("   -------------------------\n");
  fclose(UFID);

  /* Print final statistics to the screen */
  printf("\nFinal Slow Statistics:\n");
  retval = MRIStepPrintAllStats(arkode_mem, stdout, SUN_OUTPUTFORMAT_TABLE);
  printf("\nFinal Fast Statistics:\n");
  retval = ARKStepPrintAllStats(inner_arkode_mem, stdout, SUN_OUTPUTFORMAT_TABLE);

  /* Print final statistics to a file in CSV format */
  FID = fopen("ark_reaction_diffusion_mri_slow_stats.csv", "w");
  retval = MRIStepPrintAllStats(arkode_mem, FID, SUN_OUTPUTFORMAT_CSV);
  fclose(FID);
  FID = fopen("ark_reaction_diffusion_mri_fast_stats.csv", "w");
  retval = ARKStepPrintAllStats(inner_arkode_mem, FID, SUN_OUTPUTFORMAT_CSV);
  fclose(FID);

  /* Clean up and return */
  N_VDestroy(y);                             /* Free y vector */
  ARKStepFree(&inner_arkode_mem);            /* Free integrator memory */
  MRIStepInnerStepper_Free(&inner_stepper);  /* Free inner stepper */
  MRIStepFree(&arkode_mem);                  /* Free integrator memory */
  free(udata);                               /* Free user data */
  SUNContext_Free(&ctx);                     /* Free context */

  return 0;
}

/* ------------------------------
 * Functions called by the solver
 * ------------------------------*/

/* ff routine to compute the fast portion of the ODE RHS. */
static int ff(realtype t, N_Vector y, N_Vector ydot, void *user_data)
{
  UserData udata = (UserData) user_data;    /* access problem data */
  sunindextype N = udata->N;                /* set variable shortcuts */
  realtype *Y=NULL, *Ydot=NULL;
  sunindextype i;

  /* access state array data */
  Y = N_VGetArrayPointer(y);
  if (check_retval((void *) Y, "N_VGetArrayPointer", 0)) return 1;

  /* access RHS array data */
  Ydot = N_VGetArrayPointer(ydot);
  if (check_retval((void *) Ydot, "N_VGetArrayPointer", 0)) return 1;

  /* iterate over domain, computing reaction term */
  for (i = 0; i < N; i++)
    Ydot[i] = Y[i] * Y[i] * (RCONST(1.0) - Y[i]);

  /* Return with success */
  return 0;
}


/* fs routine to compute the slow portion of the ODE RHS. */
static int fs(realtype t, N_Vector y, N_Vector ydot, void *user_data)
{
  UserData udata = (UserData) user_data;    /* access problem data */
  sunindextype N = udata->N;                /* set variable shortcuts */
  realtype k  = udata->k;
  realtype dx = udata->dx;
  realtype *Y=NULL, *Ydot=NULL;
  realtype c1, c2;
  sunindextype i;

  /* access state array data */
  Y = N_VGetArrayPointer(y);
  if (check_retval((void *) Y, "N_VGetArrayPointer", 0)) return 1;

  /* access RHS array data */
  Ydot = N_VGetArrayPointer(ydot);
  if (check_retval((void *) Ydot, "N_VGetArrayPointer", 0)) return 1;

  /* iterate over domain, computing diffusion term */
  c1 = k/dx/dx;
  c2 = RCONST(2.0)*k/dx/dx;

  /* left boundary condition */
  Ydot[0] = c2*(Y[1] - Y[0]);

  /* interior points */
  for (i=1; i<N-1; i++)
    Ydot[i] = c1*Y[i-1] - c2*Y[i] + c1*Y[i+1];

  /* right boundary condition */
  Ydot[N-1] = c2*(Y[N-2] - Y[N-1]);

  /* Return with success */
  return 0;
}

/* -----------------------------------------
 * Private function to set initial condition
 * -----------------------------------------*/

static int SetInitialCondition(N_Vector y, UserData user_data)
{
  UserData udata = (UserData) user_data;    /* access problem data */
  sunindextype N = udata->N;                /* set variable shortcuts */
  realtype lam = udata->lam;
  realtype dx = udata->dx;
  realtype *Y=NULL;
  sunindextype i;

  /* access state array data */
  Y = N_VGetArrayPointer(y);
  if (check_retval((void *) Y, "N_VGetArrayPointer", 0)) return -1;

  /* set initial condition */
  for (i = 0; i < N; i++)
    Y[i] = RCONST(1.0)/(1 + exp(lam*(i*dx-RCONST(1.0))));

  /* Return with success */
  return 0;
}

/* ------------------------------
 * Private helper functions
 * ------------------------------*/

/* Check function return value...
    opt == 0 means SUNDIALS function allocates memory so check if
             returned NULL pointer
    opt == 1 means SUNDIALS function returns a retval so check if
             retval < 0
    opt == 2 means function allocates memory so check if returned
             NULL pointer
*/
static int check_retval(void *returnvalue, const char *funcname, int opt)
{
  int *retval;

  /* Check if SUNDIALS function returned NULL pointer - no memory allocated */
  if (opt == 0 && returnvalue == NULL) {
    fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n",
            funcname);
    return 1; }

  /* Check if retval < 0 */
  else if (opt == 1) {
    retval = (int *) returnvalue;
    if (*retval < 0) {
      fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with retval = %d\n\n",
              funcname, *retval);
      return 1; }}

  /* Check if function returned NULL pointer - no memory allocated */
  else if (opt == 2 && returnvalue == NULL) {
    fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n",
            funcname);
    return 1; }

  return 0;
}


/*---- end of file ----*/