Actual source code: ex10.c
petsc-3.8.4 2018-03-24
1: static char help[] = "Solves C_t = -D*C_xx + F(C) + R(C) + D(C) from Brian Wirth's SciDAC project.\n";
3: /*
4: C_t = -D*C_xx + F(C) + R(C) + D(C) from Brian Wirth's SciDAC project.
6: D*C_xx - diffusion of He[1-5] and V[1] and I[1]
7: F(C) - forcing function; He being created.
8: R(C) - reaction terms (clusters combining)
9: D(C) - dissociation terms (cluster breaking up)
11: Sample Options:
12: -ts_monitor_draw_solution -- plot the solution for each concentration as a function of x each in a separate 1d graph
13: -draw_fields_by_name 1-He-2-V,1-He -- only plot the solution for these two concentrations
14: -mymonitor -- plot the concentrations of He and V as a function of x and cluster size (2d contour plot)
15: -da_refine <n=1,2,...> -- run on a finer grid
16: -ts_max_steps maxsteps -- maximum number of time-steps to take
17: -ts_final_time time -- maximum time to compute to
19: */
20: #define PETSC_SKIP_COMPLEX 1
22: #include <petscdm.h>
23: #include <petscdmda.h>
24: #include <petscts.h>
26: /* Hard wire the number of cluster sizes for He, V, and I, and He-V */
27: #define NHe 9
28: #define NV 10 /* 50 */
29: #define NI 2
30: #define MHeV 10 /* 50 */ /* maximum V size in He-V */
31: PetscInt NHeV[MHeV+1]; /* maximum He size in an He-V with given V */
32: #define MNHeV 451 /* 6778 */
33: #define DOF (NHe + NV + NI + MNHeV)
35: /*
36: Define all the concentrations (there is one of these structs at each grid point)
38: He[He] represents the clusters of pure Helium of size He
39: V[V] the Vacencies of size V,
40: I[I] represents the clusters of Interstials of size I, and
41: HeV[He][V] the mixed Helium-Vacancy clusters of size He and V
43: The variables He, V, I are always used to index into the concentrations of He, V, and I respectively
44: Note that unlike in traditional C code the indices for He[], V[] and I[] run from 1 to N, NOT 0 to N-1
46: */
47: typedef struct {
48: PetscScalar He[NHe];
49: PetscScalar V[NV];
50: PetscScalar I[NI];
51: PetscScalar HeV[MNHeV];
52: } Concentrations;
56: /*
57: Holds problem specific options and data
58: */
59: typedef struct {
60: PetscScalar HeDiffusion[6];
61: PetscScalar VDiffusion[2];
62: PetscScalar IDiffusion[2];
63: PetscScalar forcingScale;
64: PetscScalar reactionScale;
65: PetscScalar dissociationScale;
66: } AppCtx;
68: extern PetscErrorCode RHSFunction(TS,PetscReal,Vec,Vec,void*);
69: extern PetscErrorCode RHSJacobian(TS,PetscReal,Vec,Mat,Mat,void*);
70: extern PetscErrorCode InitialConditions(DM,Vec);
71: extern PetscErrorCode GetDfill(PetscInt*,void*);
72: extern PetscErrorCode MyLoadData(MPI_Comm,const char*);
74: int main(int argc,char **argv)
75: {
76: TS ts; /* nonlinear solver */
77: Vec C; /* solution */
79: DM da; /* manages the grid data */
80: AppCtx ctx; /* holds problem specific paramters */
81: PetscInt He,*ofill,*dfill;
82: char filename[PETSC_MAX_PATH_LEN];
83: PetscBool flg;
85: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
86: Initialize program
87: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
88: PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
91: PetscOptionsGetString(NULL,NULL,"-file",filename,PETSC_MAX_PATH_LEN,&flg);
92: if (flg) {
93: MyLoadData(PETSC_COMM_WORLD,filename);
94: }
97: ctx.HeDiffusion[1] = 1000*2.95e-4; /* From Tibo's notes times 1,000 */
98: ctx.HeDiffusion[2] = 1000*3.24e-4;
99: ctx.HeDiffusion[3] = 1000*2.26e-4;
100: ctx.HeDiffusion[4] = 1000*1.68e-4;
101: ctx.HeDiffusion[5] = 1000*5.20e-5;
102: ctx.VDiffusion[1] = 1000*2.71e-3;
103: ctx.IDiffusion[1] = 1000*2.13e-4;
104: ctx.forcingScale = 100.; /* made up numbers */
105: ctx.reactionScale = .001;
106: ctx.dissociationScale = .0001;
108: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109: Create distributed array (DMDA) to manage parallel grid and vectors
110: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
111: DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_MIRROR,1,DOF,0,NULL,&da);
112: DMSetFromOptions(da);
113: DMSetUp(da);
115: /* The only spatial coupling in the Jacobian (diffusion) is for the first 5 He, the first V, and the first I.
116: The ofill (thought of as a DOF by DOF 2d (row-oriented) array) represents the nonzero coupling between degrees
117: of freedom at one point with degrees of freedom on the adjacent point to the left or right. A 1 at i,j in the
118: ofill array indicates that the degree of freedom i at a point is coupled to degree of freedom j at the
119: adjacent point. In this case ofill has only a few diagonal entries since the only spatial coupling is regular diffusion. */
120: PetscMalloc1(DOF*DOF,&ofill);
121: PetscMalloc1(DOF*DOF,&dfill);
122: PetscMemzero(ofill,DOF*DOF*sizeof(PetscInt));
123: PetscMemzero(dfill,DOF*DOF*sizeof(PetscInt));
125: /*
126: dfil (thought of as a DOF by DOF 2d (row-oriented) array) repesents the nonzero coupling between degrees of
127: freedom within a single grid point, i.e. the reaction and dissassociation interactions. */
128: PetscMalloc1(DOF*DOF,&dfill);
129: PetscMemzero(dfill,DOF*DOF*sizeof(PetscInt));
130: GetDfill(dfill,&ctx);
131: DMDASetBlockFills(da,dfill,ofill);
132: PetscFree(ofill);
133: PetscFree(dfill);
135: /* Extract global vector to hold solution */
136: DMCreateGlobalVector(da,&C);
138: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
139: Create timestepping solver context
140: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
141: TSCreate(PETSC_COMM_WORLD,&ts);
142: TSSetType(ts,TSARKIMEX);
143: TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);
144: TSSetDM(ts,da);
145: TSSetProblemType(ts,TS_NONLINEAR);
146: TSSetRHSFunction(ts,NULL,RHSFunction,&ctx);
147: TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,&ctx);
148: TSSetSolution(ts,C);
150: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151: Set solver options
152: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
153: TSSetTimeStep(ts,.001);
154: TSSetMaxSteps(ts,100);
155: TSSetMaxTime(ts,50.0);
156: TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
157: TSSetFromOptions(ts);
159: InitialConditions(da,C);
161: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162: Solve the ODE system
163: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
164: TSSolve(ts,C);
166: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
167: Free work space.
168: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
169: VecDestroy(&C);
170: TSDestroy(&ts);
171: DMDestroy(&da);
172: PetscFinalize();
173: return(0);
174: }
176: /*
177: cHeV is "trick" to allow easy accessing of the values in the HeV portion of the Concentrations.
178: cHeV[i] points to the beginning of each row of HeV[] with V indexing starting a 1.
180: */
181: PetscErrorCode cHeVCreate(PetscReal ***cHeV)
182: {
186: PetscMalloc(MHeV*sizeof(PetscScalar),cHeV);
187: (*cHeV)--;
188: return(0);
189: }
191: PetscErrorCode cHeVInitialize(const PetscScalar *start,PetscReal **cHeV)
192: {
193: PetscInt i;
196: cHeV[1] = ((PetscScalar*) start) - 1 + NHe + NV + NI;
197: for (i=1; i<MHeV; i++) {
198: cHeV[i+1] = cHeV[i] + NHeV[i];
199: }
200: return(0);
201: }
203: PetscErrorCode cHeVDestroy(PetscReal **cHeV)
204: {
208: cHeV++;
209: PetscFree(cHeV);
210: return(0);
211: }
213: /* ------------------------------------------------------------------- */
214: PetscErrorCode InitialConditions(DM da,Vec C)
215: {
217: PetscInt i,I,He,V,xs,xm,Mx,cnt = 0;
218: Concentrations *c;
219: PetscReal hx,x,**cHeV;
220: char string[16];
223: DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
224: hx = 1.0/(PetscReal)(Mx-1);
226: /* Name each of the concentrations */
227: for (He=1; He<NHe+1; He++) {
228: PetscSNPrintf(string,16,"%d-He",He);
229: DMDASetFieldName(da,cnt++,string);
230: }
231: for (V=1; V<NV+1; V++) {
232: PetscSNPrintf(string,16,"%d-V",V);
233: DMDASetFieldName(da,cnt++,string);
234: }
235: for (I=1; I<NI+1; I++) {
236: PetscSNPrintf(string,16,"%d-I",I);
237: DMDASetFieldName(da,cnt++,string);
238: }
239: for (He=1; He<MHeV+1; He++) {
240: for (V=1; V<NHeV[He]+1; V++) {
241: PetscSNPrintf(string,16,"%d-He-%d-V",He,V);
242: DMDASetFieldName(da,cnt++,string);
243: }
244: }
246: /*
247: Get pointer to vector data
248: */
249: DMDAVecGetArrayRead(da,C,&c);
250: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
251: c = (Concentrations*)(((PetscScalar*)c)-1);
253: /*
254: Get local grid boundaries
255: */
256: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
258: /*
259: Compute function over the locally owned part of the grid
260: */
261: cHeVCreate(&cHeV);
262: for (i=xs; i<xs+xm; i++) {
263: x = i*hx;
264: for (He=1; He<NHe+1; He++) c[i].He[He] = 0.0;
265: for (V=1; V<NV+1; V++) c[i].V[V] = 1.0;
266: for (I=1; I <NI+1; I++) c[i].I[I] = 1.0;
267: cHeVInitialize(&c[i].He[1],cHeV);
268: for (V=1; V<MHeV+1; V++) {
269: for (He=1; He<NHeV[V]+1; He++) cHeV[V][He] = 0.0;
270: }
271: }
272: cHeVDestroy(cHeV);
274: /*
275: Restore vectors
276: */
277: c = (Concentrations*)(((PetscScalar*)c)+1);
278: DMDAVecRestoreArrayRead(da,C,&c);
279: return(0);
280: }
282: /* ------------------------------------------------------------------- */
283: /*
284: RHSFunction - Evaluates nonlinear function that defines the ODE
286: Input Parameters:
287: . ts - the TS context
288: . U - input vector
289: . ptr - optional user-defined context
291: Output Parameter:
292: . F - function values
293: */
294: PetscErrorCode RHSFunction(TS ts,PetscReal ftime,Vec C,Vec F,void *ptr)
295: {
296: AppCtx *ctx = (AppCtx*) ptr;
297: DM da;
299: PetscInt xi,Mx,xs,xm,He,he,V,v,I,i;
300: PetscReal hx,sx,x,**cHeV,**fHeV;
301: Concentrations *c,*f;
302: Vec localC;
305: TSGetDM(ts,&da);
306: DMGetLocalVector(da,&localC);
307: DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
308: hx = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
309: cHeVCreate(&cHeV);
310: cHeVCreate(&fHeV);
312: /*
313: Scatter ghost points to local vector,using the 2-step process
314: DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
315: By placing code between these two statements, computations can be
316: done while messages are in transition.
317: */
318: DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
319: DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);
321: VecSet(F,0.0);
323: /*
324: Get pointers to vector data
325: */
326: DMDAVecGetArrayRead(da,localC,&c);
327: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
328: c = (Concentrations*)(((PetscScalar*)c)-1);
329: DMDAVecGetArray(da,F,&f);
330: f = (Concentrations*)(((PetscScalar*)f)-1);
332: /*
333: Get local grid boundaries
334: */
335: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
337: /*
338: Loop over grid points computing ODE terms for each grid point
339: */
340: for (xi=xs; xi<xs+xm; xi++) {
341: x = xi*hx;
343: /* -------------------------------------------------------------
344: ---- Compute diffusion over the locally owned part of the grid
345: */
346: /* He clusters larger than 5 do not diffuse -- are immobile */
347: for (He=1; He<PetscMin(NHe+1,6); He++) {
348: f[xi].He[He] += ctx->HeDiffusion[He]*(-2.0*c[xi].He[He] + c[xi-1].He[He] + c[xi+1].He[He])*sx;
349: }
351: /* V and I clusters ONLY of size 1 diffuse */
352: f[xi].V[1] += ctx->VDiffusion[1]*(-2.0*c[xi].V[1] + c[xi-1].V[1] + c[xi+1].V[1])*sx;
353: f[xi].I[1] += ctx->IDiffusion[1]*(-2.0*c[xi].I[1] + c[xi-1].I[1] + c[xi+1].I[1])*sx;
355: /* Mixed He - V clusters are immobile */
357: /* ----------------------------------------------------------------
358: ---- Compute forcing that produces He of cluster size 1
359: Crude cubic approximation of graph from Tibo's notes
360: */
361: f[xi].He[1] += ctx->forcingScale*PetscMax(0.0,0.0006*x*x*x - 0.0087*x*x + 0.0300*x);
363: cHeVInitialize(&c[xi].He[1],cHeV);
364: cHeVInitialize(&f[xi].He[1],fHeV);
366: /* -------------------------------------------------------------------------
367: ---- Compute dissociation terms that removes an item from a cluster
368: I assume dissociation means losing only a single item from a cluster
369: I cannot tell from the notes if clusters can break up into any sub-size.
370: */
371: /* He[He] -> He[He-1] + He[1] */
372: for (He=2; He<NHe+1; He++) {
373: f[xi].He[He-1] += ctx->dissociationScale*c[xi].He[He];
374: f[xi].He[1] += ctx->dissociationScale*c[xi].He[He];
375: f[xi].He[He] -= ctx->dissociationScale*c[xi].He[He];
376: }
378: /* V[V] -> V[V-1] + V[1] */
379: for (V=2; V<NV+1; V++) {
380: f[xi].V[V-1] += ctx->dissociationScale*c[xi].V[V];
381: f[xi].V[1] += ctx->dissociationScale*c[xi].V[V];
382: f[xi].V[V] -= ctx->dissociationScale*c[xi].V[V];
383: }
385: /* I[I] -> I[I-1] + I[1] */
386: for (I=2; I<NI+1; I++) {
387: f[xi].I[I-1] += ctx->dissociationScale*c[xi].I[I];
388: f[xi].I[1] += ctx->dissociationScale*c[xi].I[I];
389: f[xi].I[I] -= ctx->dissociationScale*c[xi].I[I];
390: }
392: /* He[He]-V[1] -> He[He] + V[1] */
393: for (He=1; He<NHeV[1]+1; He++) {
394: f[xi].He[He] += 1000*ctx->dissociationScale*cHeV[1][He];
395: f[xi].V[1] += 1000*ctx->dissociationScale*cHeV[1][He];
396: fHeV[1][He] -= 1000*ctx->dissociationScale*cHeV[1][He];
397: }
399: /* He[1]-V[V] -> He[1] + V[V] */
400: for (V=2; V<MHeV+1; V++) {
401: f[xi].He[1] += 1000*ctx->dissociationScale*cHeV[V][1];
402: f[xi].V[V] += 1000*ctx->dissociationScale*cHeV[V][1];
403: fHeV[V][1] -= 1000*ctx->dissociationScale*cHeV[V][1];
404: }
406: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
407: for (V=2; V<MHeV+1; V++) {
408: for (He=2; He<NHeV[V]+1; He++) {
409: f[xi].He[1] += 1000*ctx->dissociationScale*cHeV[V][He];
410: fHeV[V][He-1] += 1000*ctx->dissociationScale*cHeV[V][He];
411: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
412: }
413: }
415: /* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
416: for (V=2; V<MHeV+1; V++) {
417: for (He=2; He<NHeV[V-1]+1; He++) {
418: f[xi].V[1] += 1000*ctx->dissociationScale*cHeV[V][He];
419: fHeV[V-1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
420: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
421: }
422: }
424: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
425: for (V=1; V<MHeV; V++) {
426: for (He=1; He<NHeV[V]+1; He++) {
427: fHeV[V+1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
428: f[xi].I[1] += 1000*ctx->dissociationScale*cHeV[V][He];
429: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
430: }
431: }
433: /* ----------------------------------------------------------------
434: ---- Compute reaction terms that can create a cluster of given size
435: */
436: /* He[He] + He[he] -> He[He+he] */
437: for (He=2; He<NHe+1; He++) {
438: /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
439: remove the upper half since they are symmetric to the lower half of the pairs. For example
440: when He = 5 (cluster size 5) the pairs are
441: 1 4
442: 2 2
443: 3 2 these last two are not needed in the sum since they repeat from above
444: 4 1 this is why he < (He/2) + 1 */
445: for (he=1; he<(He/2)+1; he++) {
446: f[xi].He[He] += ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
448: /* remove the two clusters that merged to form the larger cluster */
449: f[xi].He[he] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
450: f[xi].He[He-he] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
451: }
452: }
454: /* V[V] + V[v] -> V[V+v] */
455: for (V=2; V<NV+1; V++) {
456: for (v=1; v<(V/2)+1; v++) {
457: f[xi].V[V] += ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
458: f[xi].V[v] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
459: f[xi].V[V-v] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
460: }
461: }
463: /* I[I] + I[i] -> I[I+i] */
464: for (I=2; I<NI+1; I++) {
465: for (i=1; i<(I/2)+1; i++) {
466: f[xi].I[I] += ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
467: f[xi].I[i] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
468: f[xi].I[I-i] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
469: }
470: }
472: /* He[1] + V[1] -> He[1]-V[1] */
473: fHeV[1][1] += 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
474: f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
475: f[xi].V[1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
477: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
478: for (V=1; V<MHeV+1; V++) {
479: for (He=1; He<NHeV[V]; He++) {
480: for (he=1; he+He<NHeV[V]+1; he++) {
481: fHeV[V][He+he] += ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
482: f[xi].He[he] -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
483: fHeV[V][He] -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
484: }
485: }
486: }
488: /* He[He]-V[V] + V[1] -> He[He][V+1] */
489: for (V=1; V<MHeV; V++) {
490: for (He=1; He<NHeV[V+1]; He++) {
491: fHeV[V+1][He] += ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
492: /* remove the two clusters that merged to form the larger cluster */
493: f[xi].V[1] -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
494: fHeV[V][He] -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
495: }
496: }
498: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
499: /* Currently the reaction rates for this are zero */
502: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
503: for (V=1; V<NV+1; V++) {
504: for (I=1; I<PetscMin(V,NI); I++) {
505: f[xi].V[V-I] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
506: f[xi].V[V] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
507: f[xi].I[I] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
508: }
509: for (I=V+1; I<NI+1; I++) {
510: f[xi].I[I-V] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
511: f[xi].V[V] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
512: f[xi].I[I] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
513: }
514: }
515: }
517: /*
518: Restore vectors
519: */
520: c = (Concentrations*)(((PetscScalar*)c)+1);
521: DMDAVecRestoreArray(da,localC,&c);
522: f = (Concentrations*)(((PetscScalar*)f)+1);
523: DMDAVecRestoreArray(da,F,&f);
524: DMRestoreLocalVector(da,&localC);
525: cHeVDestroy(cHeV);
526: cHeVDestroy(fHeV);
527: return(0);
528: }
530: /*
531: Compute the Jacobian entries based on IFuction() and insert them into the matrix
532: */
533: PetscErrorCode RHSJacobian(TS ts,PetscReal ftime,Vec C,Mat A,Mat J,void *ptr)
534: {
535: AppCtx *ctx = (AppCtx*) ptr;
536: DM da;
537: PetscErrorCode ierr;
538: PetscInt xi,Mx,xs,xm,He,he,V,v,I,i;
539: PetscInt row[3],col[3];
540: PetscReal hx,sx,x,val[6];
541: const Concentrations *c,*f;
542: Vec localC;
543: const PetscReal *rowstart,*colstart;
544: const PetscReal **cHeV,**fHeV;
545: static PetscBool initialized = PETSC_FALSE;
548: cHeVCreate((PetscScalar***)&cHeV);
549: cHeVCreate((PetscScalar***)&fHeV);
550: MatZeroEntries(J);
551: TSGetDM(ts,&da);
552: DMGetLocalVector(da,&localC);
553: DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
554: hx = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
556: DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
557: DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);
559: /*
560: The f[] is dummy, values are never set into it. It is only used to determine the
561: local row for the entries in the Jacobian
562: */
563: DMDAVecGetArray(da,localC,&c);
564: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
565: c = (Concentrations*)(((PetscScalar*)c)-1);
566: DMDAVecGetArray(da,C,&f);
567: f = (Concentrations*)(((PetscScalar*)f)-1);
569: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
571: rowstart = &f[xs].He[1] - DOF;
572: colstart = &c[xs-1].He[1];
574: if (!initialized) {
575: /*
576: Loop over grid points computing Jacobian terms for each grid point
577: */
578: for (xi=xs; xi<xs+xm; xi++) {
579: x = xi*hx;
580:
581: cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
582: cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
583:
584: /* -------------------------------------------------------------
585: ---- Compute diffusion over the locally owned part of the grid
586: */
587: /* He clusters larger than 5 do not diffuse -- are immobile */
588: for (He=1; He<PetscMin(NHe+1,6); He++) {
589: row[0] = &f[xi].He[He] - rowstart;
590: col[0] = &c[xi-1].He[He] - colstart;
591: col[1] = &c[xi].He[He] - colstart;
592: col[2] = &c[xi+1].He[He] - colstart;
593: val[0] = ctx->HeDiffusion[He]*sx;
594: val[1] = -2.0*ctx->HeDiffusion[He]*sx;
595: val[2] = ctx->HeDiffusion[He]*sx;
596: MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
597: }
599: /* V and I clusters ONLY of size 1 diffuse */
600: row[0] = &f[xi].V[1] - rowstart;
601: col[0] = &c[xi-1].V[1] - colstart;
602: col[1] = &c[xi].V[1] - colstart;
603: col[2] = &c[xi+1].V[1] - colstart;
604: val[0] = ctx->VDiffusion[1]*sx;
605: val[1] = -2.0*ctx->VDiffusion[1]*sx;
606: val[2] = ctx->VDiffusion[1]*sx;
607: MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
608:
609: row[0] = &f[xi].I[1] - rowstart;
610: col[0] = &c[xi-1].I[1] - colstart;
611: col[1] = &c[xi].I[1] - colstart;
612: col[2] = &c[xi+1].I[1] - colstart;
613: val[0] = ctx->IDiffusion[1]*sx;
614: val[1] = -2.0*ctx->IDiffusion[1]*sx;
615: val[2] = ctx->IDiffusion[1]*sx;
616: MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
617:
618: /* Mixed He - V clusters are immobile */
619:
620: /* -------------------------------------------------------------------------
621: ---- Compute dissociation terms that removes an item from a cluster
622: I assume dissociation means losing only a single item from a cluster
623: I cannot tell from the notes if clusters can break up into any sub-size.
624: */
625:
626: /* He[He] -> He[He-1] + He[1] */
627: for (He=2; He<NHe+1; He++) {
628: row[0] = &f[xi].He[He-1] - rowstart;
629: row[1] = &f[xi].He[1] - rowstart;
630: row[2] = &f[xi].He[He] - rowstart;
631: col[0] = &c[xi].He[He] - colstart;
632: val[0] = ctx->dissociationScale;
633: val[1] = ctx->dissociationScale;
634: val[2] = -ctx->dissociationScale;
635: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
636: }
637:
638: /* V[V] -> V[V-1] + V[1] */
639: for (V=2; V<NV+1; V++) {
640: row[0] = &f[xi].V[V-1] - rowstart;
641: row[1] = &f[xi].V[1] - rowstart;
642: row[2] = &f[xi].V[V] - rowstart;
643: col[0] = &c[xi].V[V] - colstart;
644: val[0] = ctx->dissociationScale;
645: val[1] = ctx->dissociationScale;
646: val[2] = -ctx->dissociationScale;
647: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
648: }
649:
650: /* I[I] -> I[I-1] + I[1] */
651: for (I=2; I<NI+1; I++) {
652: row[0] = &f[xi].I[I-1] - rowstart;
653: row[1] = &f[xi].I[1] - rowstart;
654: row[2] = &f[xi].I[I] - rowstart;
655: col[0] = &c[xi].I[I] - colstart;
656: val[0] = ctx->dissociationScale;
657: val[1] = ctx->dissociationScale;
658: val[2] = -ctx->dissociationScale;
659: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
660: }
661:
662: /* He[He]-V[1] -> He[He] + V[1] */
663: for (He=1; He<NHeV[1]+1; He++) {
664: row[0] = &f[xi].He[He] - rowstart;
665: row[1] = &f[xi].V[1] - rowstart;
666: row[2] = &fHeV[1][He] - rowstart;
667: col[0] = &cHeV[1][He] - colstart;
668: val[0] = 1000*ctx->dissociationScale;
669: val[1] = 1000*ctx->dissociationScale;
670: val[2] = -1000*ctx->dissociationScale;
671: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
672: }
673:
674: /* He[1]-V[V] -> He[1] + V[V] */
675: for (V=2; V<MHeV+1; V++) {
676: row[0] = &f[xi].He[1] - rowstart;
677: row[1] = &f[xi].V[V] - rowstart;
678: row[2] = &fHeV[V][1] - rowstart;
679: col[0] = &cHeV[V][1] - colstart;
680: val[0] = 1000*ctx->dissociationScale;
681: val[1] = 1000*ctx->dissociationScale;
682: val[2] = -1000*ctx->dissociationScale;
683: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
684: }
685:
686: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
687: for (V=2; V<MHeV+1; V++) {
688: for (He=2; He<NHeV[V]+1; He++) {
689: row[0] = &f[xi].He[1] - rowstart;
690: row[1] = &fHeV[V][He-1] - rowstart;
691: row[2] = &fHeV[V][He] - rowstart;
692: col[0] = &cHeV[V][He] - colstart;
693: val[0] = 1000*ctx->dissociationScale;
694: val[1] = 1000*ctx->dissociationScale;
695: val[2] = -1000*ctx->dissociationScale;
696: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
697: }
698: }
699:
700: /* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
701: for (V=2; V<MHeV+1; V++) {
702: for (He=2; He<NHeV[V-1]+1; He++) {
703: row[0] = &f[xi].V[1] - rowstart;
704: row[1] = &fHeV[V-1][He] - rowstart;
705: row[2] = &fHeV[V][He] - rowstart;
706: col[0] = &cHeV[V][He] - colstart;
707: val[0] = 1000*ctx->dissociationScale;
708: val[1] = 1000*ctx->dissociationScale;
709: val[2] = -1000*ctx->dissociationScale;
710: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
711: }
712: }
713:
714: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
715: for (V=1; V<MHeV; V++) {
716: for (He=1; He<NHeV[V]+1; He++) {
717: row[0] = &fHeV[V+1][He] - rowstart;
718: row[1] = &f[xi].I[1] - rowstart;
719: row[2] = &fHeV[V][He] - rowstart;
720: col[0] = &cHeV[V][He] - colstart;
721: val[0] = 1000*ctx->dissociationScale;
722: val[1] = 1000*ctx->dissociationScale;
723: val[2] = -1000*ctx->dissociationScale;
724: MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
725: }
726: }
727: }
728: MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
729: MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
730: MatSetOption(J,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
731: MatStoreValues(J);
732: MatSetFromOptions(J);
733: initialized = PETSC_TRUE;
734: } else {
735: MatRetrieveValues(J);
736: }
738: /*
739: Loop over grid points computing Jacobian terms for each grid point for reaction terms
740: */
741: for (xi=xs; xi<xs+xm; xi++) {
742: x = xi*hx;
743: cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
744: cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
745: /* ----------------------------------------------------------------
746: ---- Compute reaction terms that can create a cluster of given size
747: */
748: /* He[He] + He[he] -> He[He+he] */
749: for (He=2; He<NHe+1; He++) {
750: /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
751: remove the upper half since they are symmetric to the lower half of the pairs. For example
752: when He = 5 (cluster size 5) the pairs are
753: 1 4
754: 2 2
755: 3 2 these last two are not needed in the sum since they repeat from above
756: 4 1 this is why he < (He/2) + 1 */
757: for (he=1; he<(He/2)+1; he++) {
758: row[0] = &f[xi].He[He] - rowstart;
759: row[1] = &f[xi].He[he] - rowstart;
760: row[2] = &f[xi].He[He-he] - rowstart;
761: col[0] = &c[xi].He[he] - colstart;
762: col[1] = &c[xi].He[He-he] - colstart;
763: val[0] = ctx->reactionScale*c[xi].He[He-he];
764: val[1] = ctx->reactionScale*c[xi].He[he];
765: val[2] = -ctx->reactionScale*c[xi].He[He-he];
766: val[3] = -ctx->reactionScale*c[xi].He[he];
767: val[4] = -ctx->reactionScale*c[xi].He[He-he];
768: val[5] = -ctx->reactionScale*c[xi].He[he];
769: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
770: }
771: }
773: /* V[V] + V[v] -> V[V+v] */
774: for (V=2; V<NV+1; V++) {
775: for (v=1; v<(V/2)+1; v++) {
776: row[0] = &f[xi].V[V] - rowstart;
777: row[1] = &f[xi].V[v] - rowstart;
778: row[2] = &f[xi].V[V-v] - rowstart;
779: col[0] = &c[xi].V[v] - colstart;
780: col[1] = &c[xi].V[V-v] - colstart;
781: val[0] = ctx->reactionScale*c[xi].V[V-v];
782: val[1] = ctx->reactionScale*c[xi].V[v];
783: val[2] = -ctx->reactionScale*c[xi].V[V-v];
784: val[3] = -ctx->reactionScale*c[xi].V[v];
785: val[4] = -ctx->reactionScale*c[xi].V[V-v];
786: val[5] = -ctx->reactionScale*c[xi].V[v];
787: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
788: }
789: }
791: /* I[I] + I[i] -> I[I+i] */
792: for (I=2; I<NI+1; I++) {
793: for (i=1; i<(I/2)+1; i++) {
794: row[0] = &f[xi].I[I] - rowstart;
795: row[1] = &f[xi].I[i] - rowstart;
796: row[2] = &f[xi].I[I-i] - rowstart;
797: col[0] = &c[xi].I[i] - colstart;
798: col[1] = &c[xi].I[I-i] - colstart;
799: val[0] = ctx->reactionScale*c[xi].I[I-i];
800: val[1] = ctx->reactionScale*c[xi].I[i];
801: val[2] = -ctx->reactionScale*c[xi].I[I-i];
802: val[3] = -ctx->reactionScale*c[xi].I[i];
803: val[4] = -ctx->reactionScale*c[xi].I[I-i];
804: val[5] = -ctx->reactionScale*c[xi].I[i];
805: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
806: }
807: }
809: /* He[1] + V[1] -> He[1]-V[1] */
810: row[0] = &fHeV[1][1] - rowstart;
811: row[1] = &f[xi].He[1] - rowstart;
812: row[2] = &f[xi].V[1] - rowstart;
813: col[0] = &c[xi].He[1] - colstart;
814: col[1] = &c[xi].V[1] - colstart;
815: val[0] = 1000*ctx->reactionScale*c[xi].V[1];
816: val[1] = 1000*ctx->reactionScale*c[xi].He[1];
817: val[2] = -1000*ctx->reactionScale*c[xi].V[1];
818: val[3] = -1000*ctx->reactionScale*c[xi].He[1];
819: val[4] = -1000*ctx->reactionScale*c[xi].V[1];
820: val[5] = -1000*ctx->reactionScale*c[xi].He[1];
821: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
823: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
824: for (V=1; V<MHeV+1; V++) {
825: for (He=1; He<NHeV[V]; He++) {
826: for (he=1; he+He<NHeV[V]+1; he++) {
827: row[0] = &fHeV[V][He+he] - rowstart;
828: row[1] = &f[xi].He[he] - rowstart;
829: row[2] = &fHeV[V][He] - rowstart;
830: col[0] = &c[xi].He[he] - colstart;
831: col[1] = &cHeV[V][He] - colstart;
832: val[0] = ctx->reactionScale*cHeV[V][He];
833: val[1] = ctx->reactionScale*c[xi].He[he];
834: val[2] = -ctx->reactionScale*cHeV[V][He];
835: val[3] = -ctx->reactionScale*c[xi].He[he];
836: val[4] = -ctx->reactionScale*cHeV[V][He];
837: val[5] = -ctx->reactionScale*c[xi].He[he];
838: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
839: }
840: }
841: }
843: /* He[He]-V[V] + V[1] -> He[He][V+1] */
844: for (V=1; V<MHeV; V++) {
845: for (He=1; He<NHeV[V+1]; He++) {
846: row[0] = &fHeV[V+1][He] - rowstart;
847: row[1] = &f[xi].V[1] - rowstart;
848: row[2] = &fHeV[V][He] - rowstart;
849: col[0] = &c[xi].V[1] - colstart;
850: col[1] = &cHeV[V][He] - colstart;
851: val[0] = ctx->reactionScale*cHeV[V][He];
852: val[1] = ctx->reactionScale*c[xi].V[1];
853: val[2] = -ctx->reactionScale*cHeV[V][He];
854: val[3] = -ctx->reactionScale*c[xi].V[1];
855: val[4] = -ctx->reactionScale*cHeV[V][He];
856: val[5] = -ctx->reactionScale*c[xi].V[1];
857: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
858: }
859: }
861: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
862: /* Currently the reaction rates for this are zero */
865: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
866: for (V=1; V<NV+1; V++) {
867: for (I=1; I<PetscMin(V,NI); I++) {
868: row[0] = &f[xi].V[V-I] - rowstart;
869: row[1] = &f[xi].V[V] - rowstart;
870: row[2] = &f[xi].I[I] - rowstart;
871: col[0] = &c[xi].V[V] - colstart;
872: col[1] = &c[xi].I[I] - colstart;
873: val[0] = ctx->reactionScale*c[xi].I[I];
874: val[1] = ctx->reactionScale*c[xi].V[V];
875: val[2] = -ctx->reactionScale*c[xi].I[I];
876: val[3] = -ctx->reactionScale*c[xi].V[V];
877: val[4] = -ctx->reactionScale*c[xi].I[I];
878: val[5] = -ctx->reactionScale*c[xi].V[V];
879: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
880: }
881: for (I=V+1; I<NI+1; I++) {
882: row[0] = &f[xi].I[I-V] - rowstart;
883: row[1] = &f[xi].V[V] - rowstart;
884: row[2] = &f[xi].I[I] - rowstart;
885: col[0] = &c[xi].V[V] - colstart;
886: col[1] = &c[xi].I[I] - colstart;
887: val[0] = ctx->reactionScale*c[xi].I[I];
888: val[1] = ctx->reactionScale*c[xi].V[V];
889: val[2] = -ctx->reactionScale*c[xi].I[I];
890: val[3] = -ctx->reactionScale*c[xi].V[V];
891: val[4] = -ctx->reactionScale*c[xi].I[I];
892: val[5] = -ctx->reactionScale*c[xi].V[V];
893: MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
894: }
895: }
896: }
898: /*
899: Restore vectors
900: */
901: c = (Concentrations*)(((PetscScalar*)c)+1);
902: DMDAVecRestoreArray(da,localC,&c);
903: f = (Concentrations*)(((PetscScalar*)f)+1);
904: DMDAVecRestoreArray(da,C,&f);
905: DMRestoreLocalVector(da,&localC);
906: cHeVDestroy((PetscScalar**)cHeV);
907: cHeVDestroy((PetscScalar**)fHeV);
909: MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
910: MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
911: if (A != J) {
912: MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
913: MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
914: }
915: return(0);
916: }
918: /*
919: Determines the nonzero structure within the diagonal blocks of the Jacobian that represent coupling resulting from reactions and
920: dissasociations of the clusters
921: */
922: PetscErrorCode GetDfill(PetscInt *dfill, void *ptr)
923: {
924: PetscInt He,he,V,v,I,i,j,k,rows[3],cols[2];
925: Concentrations *c;
926: PetscScalar *idxstart,**cHeV;
929: /* ensure fill for the diagonal of matrix */
930: for (i=0; i<(DOF); i++) {
931: dfill[i*DOF + i] = 1;
932: }
934: /*
935: c is never used except for computing offsets between variables which are used to fill the non-zero
936: structure of the matrix
937: */
938: PetscNew(&c);
939: c = (Concentrations*)(((PetscScalar*)c)-1);
940: cHeVCreate(&cHeV);
941: cHeVInitialize(&c->He[1],cHeV);
942: idxstart = (PetscScalar*)&c->He[1];
944: /* -------------------------------------------------------------------------
945: ---- Compute dissociation terms that removes an item from a cluster
946: I assume dissociation means losing only a single item from a cluster
947: I cannot tell from the notes if clusters can break up into any sub-size.
948: */
949: /* He[He] -> He[He-1] + He[1] */
950: for (He=2; He<NHe+1; He++) {
951: rows[0] = &c->He[He-1] - idxstart;
952: rows[1] = &c->He[1] - idxstart;
953: rows[2] = &c->He[He] - idxstart;
954: cols[0] = &c->He[He] - idxstart;
955: for (j=0; j<3; j++) {
956: dfill[rows[j]*DOF + cols[0]] = 1;
957: }
958: }
960: /* V[V] -> V[V-1] + V[1] */
961: for (V=2; V<NV+1; V++) {
962: rows[0] = &c->V[V] - idxstart;
963: rows[1] = &c->V[1] - idxstart;
964: rows[2] = &c->V[V-1] - idxstart;
965: cols[0] = &c->V[V] - idxstart;
966: for (j=0; j<3; j++) {
967: dfill[rows[j]*DOF + cols[0]] = 1;
968: }
969: }
970:
971: /* I[I] -> I[I-1] + I[1] */
972: for (I=2; I<NI+1; I++) {
973: rows[0] = &c->I[I] - idxstart;
974: rows[1] = &c->I[1] - idxstart;
975: rows[2] = &c->I[I-1] - idxstart;
976: cols[0] = &c->I[I] - idxstart;
977: for (j=0; j<3; j++) {
978: dfill[rows[j]*DOF + cols[0]] = 1;
979: }
980: }
981:
982: /* He[He]-V[1] -> He[He] + V[1] */
983: for (He=1; He<NHeV[1]+1; He++) {
984: rows[0] = &c->He[He] - idxstart;
985: rows[1] = &c->V[1] - idxstart;
986: rows[2] = &cHeV[1][He] - idxstart;
987: cols[0] = &cHeV[1][He] - idxstart;
988: for (j=0; j<3; j++) {
989: dfill[rows[j]*DOF + cols[0]] = 1;
990: }
991: }
992:
993: /* He[1]-V[V] -> He[1] + V[V] */
994: for (V=2; V<MHeV+1; V++) {
995: rows[0] = &c->He[1] - idxstart;
996: rows[1] = &c->V[V] - idxstart;
997: rows[2] = &cHeV[V][1] - idxstart;
998: cols[0] = &cHeV[V][1] - idxstart;
999: for (j=0; j<3; j++) {
1000: dfill[rows[j]*DOF + cols[0]] = 1;
1001: }
1002: }
1003:
1004: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
1005: for (V=2; V<MHeV+1; V++) {
1006: for (He=2; He<NHeV[V]+1; He++) {
1007: rows[0] = &c->He[1] - idxstart;
1008: rows[1] = &cHeV[V][He] - idxstart;
1009: rows[2] = &cHeV[V][He-1] - idxstart;
1010: cols[0] = &cHeV[V][He] - idxstart;
1011: for (j=0; j<3; j++) {
1012: dfill[rows[j]*DOF + cols[0]] = 1;
1013: }
1014: }
1015: }
1016:
1017: /* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
1018: for (V=2; V<MHeV+1; V++) {
1019: for (He=2; He<NHeV[V-1]+1; He++) {
1020: rows[0] = &c->V[1] - idxstart;
1021: rows[1] = &cHeV[V][He] - idxstart;
1022: rows[2] = &cHeV[V-1][He] - idxstart;
1023: cols[0] = &cHeV[V][He] - idxstart;
1024: for (j=0; j<3; j++) {
1025: dfill[rows[j]*DOF + cols[0]] = 1;
1026: }
1027: }
1028: }
1029:
1030: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
1031: for (V=1; V<MHeV; V++) {
1032: for (He=1; He<NHeV[V]+1; He++) {
1033: rows[0] = &c->I[1] - idxstart;
1034: rows[1] = &cHeV[V+1][He] - idxstart;
1035: rows[2] = &cHeV[V][He] - idxstart;
1036: cols[0] = &cHeV[V][He] - idxstart;
1037: for (j=0; j<3; j++) {
1038: dfill[rows[j]*DOF + cols[0]] = 1;
1039: }
1040: }
1041: }
1043: /* These are the reaction terms in the diagonal block */
1044: for (He=2; He<NHe+1; He++) {
1045: for (he=1; he<(He/2)+1; he++) {
1046: rows[0] = &c->He[He] - idxstart;
1047: rows[1] = &c->He[he] - idxstart;
1048: rows[2] = &c->He[He-he] - idxstart;
1049: cols[0] = &c->He[he] - idxstart;
1050: cols[1] = &c->He[He-he] - idxstart;
1051: for (j=0; j<3; j++) {
1052: for (k=0; k<2; k++) {
1053: dfill[rows[j]*DOF + cols[k]] = 1;
1054: }
1055: }
1056: }
1057: }
1059: /* V[V] + V[v] -> V[V+v] */
1060: for (V=2; V<NV+1; V++) {
1061: for (v=1; v<(V/2)+1; v++) {
1062: rows[0] = &c->V[V] - idxstart;
1063: rows[1] = &c->V[v] - idxstart;
1064: rows[2] = &c->V[V-v] - idxstart;
1065: cols[0] = &c->V[v] - idxstart;
1066: cols[1] = &c->V[V-v] - idxstart;
1067: for (j=0; j<3; j++) {
1068: for (k=0; k<2; k++) {
1069: dfill[rows[j]*DOF + cols[k]] = 1;
1070: }
1071: }
1072: }
1073: }
1074:
1075: /* I[I] + I[i] -> I[I+i] */
1076: for (I=2; I<NI+1; I++) {
1077: for (i=1; i<(I/2)+1; i++) {
1078: rows[0] = &c->I[I] - idxstart;
1079: rows[1] = &c->I[i] - idxstart;
1080: rows[2] = &c->I[I-i] - idxstart;
1081: cols[0] = &c->I[i] - idxstart;
1082: cols[1] = &c->I[I-i] - idxstart;
1083: for (j=0; j<3; j++) {
1084: for (k=0; k<2; k++) {
1085: dfill[rows[j]*DOF + cols[k]] = 1;
1086: }
1087: }
1088: }
1089: }
1090:
1091: /* He[1] + V[1] -> He[1]-V[1] */
1092: rows[0] = &cHeV[1][1] - idxstart;
1093: rows[1] = &c->He[1] - idxstart;
1094: rows[2] = &c->V[1] - idxstart;
1095: cols[0] = &c->He[1] - idxstart;
1096: cols[1] = &c->V[1] - idxstart;
1097: for (j=0; j<3; j++) {
1098: for (k=0; k<2; k++) {
1099: dfill[rows[j]*DOF + cols[k]] = 1;
1100: }
1101: }
1102:
1103: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
1104: for (V=1; V<MHeV+1; V++) {
1105: for (He=1; He<NHeV[V]; He++) {
1106: for (he=1; he+He<NHeV[V]+1; he++) {
1107: rows[0] = &cHeV[V][He+he] - idxstart;
1108: rows[1] = &c->He[he] - idxstart;
1109: rows[2] = &cHeV[V][He] - idxstart;
1110: cols[0] = &cHeV[V][He] - idxstart;
1111: cols[1] = &c->He[he] - idxstart;
1112: for (j=0; j<3; j++) {
1113: for (k=0; k<2; k++) {
1114: dfill[rows[j]*DOF + cols[k]] = 1;
1115: }
1116: }
1117: }
1118: }
1119: }
1120: /* He[He]-V[V] + V[1] -> He[He][V+1] */
1121: for (V=1; V<MHeV; V++) {
1122: for (He=1; He<NHeV[V+1]; He++) {
1123: rows[0] = &cHeV[V+1][He] - idxstart;
1124: rows[1] = &c->V[1] - idxstart;
1125: rows[2] = &cHeV[V][He] - idxstart;
1126: cols[0] = &cHeV[V][He] - idxstart;
1127: cols[1] = &c->V[1] - idxstart;
1128: for (j=0; j<3; j++) {
1129: for (k=0; k<2; k++) {
1130: dfill[rows[j]*DOF + cols[k]] = 1;
1131: }
1132: }
1133: }
1134: }
1136: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
1137: /* Currently the reaction rates for this are zero */
1138:
1139: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
1140: for (V=1; V<NV+1; V++) {
1141: for (I=1; I<PetscMin(V,NI); I++) {
1142: rows[0] = &c->V[V-I] - idxstart;
1143: rows[1] = &c->V[V] - idxstart;
1144: rows[2] = &c->I[I] - idxstart;
1145: cols[0] = &c->V[V] - idxstart;
1146: cols[1] = &c->I[I] - idxstart;
1147: for (j=0; j<3; j++) {
1148: for (k=0; k<2; k++) {
1149: dfill[rows[j]*DOF + cols[k]] = 1;
1150: }
1151: }
1152: }
1153: for (I=V+1; I<NI+1; I++) {
1154: rows[0] = &c->I[I-V] - idxstart;
1155: rows[1] = &c->V[V] - idxstart;
1156: rows[2] = &c->I[I] - idxstart;
1157: cols[0] = &c->V[V] - idxstart;
1158: cols[1] = &c->I[I] - idxstart;
1159: for (j=0; j<3; j++) {
1160: for (k=0; k<2; k++) {
1161: dfill[rows[j]*DOF + cols[k]] = 1;
1162: }
1163: }
1164: }
1165: }
1167: c = (Concentrations*)(((PetscScalar*)c)+1);
1168: cHeVDestroy(cHeV);
1169: PetscFree(c);
1170: return(0);
1171: }
1172: /* ------------------------------------------------------------------- */
1175: PetscErrorCode MyLoadData(MPI_Comm comm,const char *filename)
1176: {
1178: FILE *fp;
1179: char buff[256];
1180: PetscInt He,V,I,lc = 0;
1181: char Hebindstr[32],Vbindstr[32],Ibindstr[32],trapbindstr[32],*sharp;
1182: PetscReal Hebind,Vbind,Ibind,trapbind;
1185: PetscFOpen(comm,filename,"r",&fp);
1186: PetscSynchronizedFGets(comm,fp,256,buff);
1187: while (buff[0]) {
1188: PetscStrchr(buff,'#',&sharp);
1189: if (!sharp) {
1190: sscanf(buff,"%d %d %d %s %s %s %s",&He,&V,&I,Hebindstr,Vbindstr,Ibindstr,trapbindstr);
1191: Hebind = strtod(Hebindstr,NULL);
1192: Vbind = strtod(Vbindstr,NULL);
1193: Ibind = strtod(Ibindstr,NULL);
1194: trapbind = strtod(trapbindstr,NULL);
1195: if (V <= NV) {
1196: if (He > NHe && V == 0 && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d %d",He,NHe);
1197: if (He == 0 && V > NV && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct V %d %d",V,NV);
1198: if (He == 0 && V == 0 && I > NI) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NI %d %d",I,NI);
1199: if (lc++ > DOF) SETERRQ4(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d NV %d NI %d MNHeV %",NHe,NV,NI,MNHeV);
1200: if (He > 0 && V > 0) { /* assumes the He are sorted in increasing order */
1201: NHeV[V] = He;
1202: }
1203: }
1204: }
1205: PetscSynchronizedFGets(comm,fp,256,buff);
1206: }
1207: if (lc != DOF) SETERRQ5(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d NV %d NI %d MNHeV %d Actual DOF %d",NHe,NV,NI,MNHeV,lc);
1208: return(0);
1209: }