Actual source code: ex10.c
petsc-dev 2014-02-02
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: */
21: #include <petscdmda.h>
22: #include <petscts.h>
24: /* Hard wire the number of cluster sizes for He, V, and I, and He-V */
25: #define NHe 9
26: #define NV 10 /* 50 */
27: #define NI 2
28: #define MHeV 10 /* 50 */ /* maximum V size in He-V */
29: PetscInt NHeV[MHeV+1]; /* maximum He size in an He-V with given V */
30: #define MNHeV 451 /* 6778 */
31: #define DOF (NHe + NV + NI + MNHeV)
33: /*
34: Define all the concentrations (there is one of these structs at each grid point)
36: He[He] represents the clusters of pure Helium of size He
37: V[V] the Vacencies of size V,
38: I[I] represents the clusters of Interstials of size I, and
39: HeV[He][V] the mixed Helium-Vacancy clusters of size He and V
41: The variables He, V, I are always used to index into the concentrations of He, V, and I respectively
42: Note that unlike in traditional C code the indices for He[], V[] and I[] run from 1 to N, NOT 0 to N-1
44: */
45: typedef struct {
46: PetscScalar He[NHe];
47: PetscScalar V[NV];
48: PetscScalar I[NI];
49: PetscScalar HeV[MNHeV];
50: } Concentrations;
54: /*
55: Holds problem specific options and data
56: */
57: typedef struct {
58: PetscScalar HeDiffusion[6];
59: PetscScalar VDiffusion[2];
60: PetscScalar IDiffusion[2];
61: PetscScalar forcingScale;
62: PetscScalar reactionScale;
63: PetscScalar dissociationScale;
64: } AppCtx;
66: extern PetscErrorCode RHSFunction(TS,PetscReal,Vec,Vec,void*);
67: extern PetscErrorCode RHSJacobian(TS,PetscReal,Vec,Mat*,Mat*,MatStructure*,void*);
68: extern PetscErrorCode InitialConditions(DM,Vec);
69: extern PetscErrorCode MyMonitorSetUp(TS);
70: extern PetscErrorCode GetDfill(PetscInt*,void*);
71: extern PetscErrorCode MyLoadData(MPI_Comm,const char*);
75: int main(int argc,char **argv)
76: {
77: TS ts; /* nonlinear solver */
78: Vec C; /* solution */
80: DM da; /* manages the grid data */
81: AppCtx ctx; /* holds problem specific paramters */
82: PetscInt He,*ofill,*dfill;
83: char filename[PETSC_MAX_PATH_LEN];
84: PetscBool flg;
86: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
87: Initialize program
88: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
89: PetscInitialize(&argc,&argv,(char*)0,help);
92: PetscOptionsGetString(NULL,"-file",filename,PETSC_MAX_PATH_LEN,&flg);
93: if (flg) {
94: MyLoadData(PETSC_COMM_WORLD,filename);
95: }
98: ctx.HeDiffusion[1] = 1000*2.95e-4; /* From Tibo's notes times 1,000 */
99: ctx.HeDiffusion[2] = 1000*3.24e-4;
100: ctx.HeDiffusion[3] = 1000*2.26e-4;
101: ctx.HeDiffusion[4] = 1000*1.68e-4;
102: ctx.HeDiffusion[5] = 1000*5.20e-5;
103: ctx.VDiffusion[1] = 1000*2.71e-3;
104: ctx.IDiffusion[1] = 1000*2.13e-4;
105: ctx.forcingScale = 100.; /* made up numbers */
106: ctx.reactionScale = .001;
107: ctx.dissociationScale = .0001;
109: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
110: Create distributed array (DMDA) to manage parallel grid and vectors
111: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
112: DMDACreate1d(PETSC_COMM_WORLD, DMDA_BOUNDARY_MIRROR,-2,DOF,1,NULL,&da);
114: /* The only spatial coupling in the Jacobian (diffusion) is for the first 5 He, the first V, and the first I.
115: The ofill (thought of as a DOF by DOF 2d (row-oriented) array) represents the nonzero coupling between degrees
116: 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
117: ofill array indicates that the degree of freedom i at a point is coupled to degree of freedom j at the
118: adjacent point. In this case ofill has only a few diagonal entries since the only spatial coupling is regular diffusion. */
119: PetscMalloc1(dof*dof,&ofill);
120: PetscMalloc1(dof*dof,&dfill);
121: PetscMemzero(ofill,dof*dof*sizeof(PetscInt));
122: PetscMemzero(dfill,dof*dof*sizeof(PetscInt));
124: /*
125: dfil (thought of as a DOF by DOF 2d (row-oriented) array) repesents the nonzero coupling between degrees of
126: freedom within a single grid point, i.e. the reaction and dissassociation interactions. */
127: PetscMalloc(DOF*DOF*sizeof(PetscInt),&dfill);
128: PetscMemzero(dfill,DOF*DOF*sizeof(PetscInt));
129: GetDfill(dfill,&ctx);
130: DMDASetBlockFills(da,dfill,ofill);
131: PetscFree(ofill);
132: PetscFree(dfill);
134: /* Extract global vector to hold solution */
135: DMCreateGlobalVector(da,&C);
137: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
138: Create timestepping solver context
139: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
140: TSCreate(PETSC_COMM_WORLD,&ts);
141: TSSetType(ts,TSARKIMEX);
142: TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);
143: TSSetDM(ts,da);
144: TSSetProblemType(ts,TS_NONLINEAR);
145: TSSetRHSFunction(ts,NULL,RHSFunction,&ctx);
146: TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,&ctx);
147: TSSetSolution(ts,C);
149: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
150: Set solver options
151: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
152: TSSetInitialTimeStep(ts,0.0,.001);
153: TSSetDuration(ts,100,50.0);
154: TSSetFromOptions(ts);
155: MyMonitorSetUp(ts);
157: InitialConditions(da,C);
159: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
160: Solve the ODE system
161: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
162: TSSolve(ts,C);
164: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
165: Free work space.
166: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
167: VecDestroy(&C);
168: TSDestroy(&ts);
169: DMDestroy(&da);
170: PetscFinalize();
171: return(0);
172: }
174: /*
175: cHeV is "trick" to allow easy accessing of the values in the HeV portion of the Concentrations.
176: cHeV[i] points to the beginning of each row of HeV[] with V indexing starting a 1.
178: */
181: PetscErrorCode cHeVCreate(PetscReal ***cHeV)
182: {
186: PetscMalloc(MHeV*sizeof(PetscScalar),cHeV);
187: (*cHeV)--;
188: return(0);
189: }
193: PetscErrorCode cHeVInitialize(const PetscScalar *start,PetscReal **cHeV)
194: {
195: PetscInt i;
198: cHeV[1] = ((PetscScalar*) start) - 1 + NHe + NV + NI;
199: for (i=1; i<MHeV; i++) {
200: cHeV[i+1] = cHeV[i] + NHeV[i];
201: }
202: return(0);
203: }
207: PetscErrorCode cHeVDestroy(PetscReal **cHeV)
208: {
212: cHeV++;
213: PetscFree(cHeV);
214: return(0);
215: }
217: /* ------------------------------------------------------------------- */
220: PetscErrorCode InitialConditions(DM da,Vec C)
221: {
223: PetscInt i,I,He,V,xs,xm,Mx,cnt = 0;
224: Concentrations *c;
225: PetscReal hx,x,**cHeV;
226: char string[16];
229: 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);
230: hx = 1.0/(PetscReal)(Mx-1);
232: /* Name each of the concentrations */
233: for (He=1; He<NHe+1; He++) {
234: PetscSNPrintf(string,16,"%d-He",He);
235: DMDASetFieldName(da,cnt++,string);
236: }
237: for (V=1; V<NV+1; V++) {
238: PetscSNPrintf(string,16,"%d-V",V);
239: DMDASetFieldName(da,cnt++,string);
240: }
241: for (I=1; I<NI+1; I++) {
242: PetscSNPrintf(string,16,"%d-I",I);
243: DMDASetFieldName(da,cnt++,string);
244: }
245: for (He=1; He<MHeV+1; He++) {
246: for (V=1; V<NHeV[He]+1; V++) {
247: PetscSNPrintf(string,16,"%d-He-%d-V",He,V);
248: DMDASetFieldName(da,cnt++,string);
249: }
250: }
252: /*
253: Get pointer to vector data
254: */
255: DMDAVecGetArray(da,C,&c);
256: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
257: c = (Concentrations*)(((PetscScalar*)c)-1);
259: /*
260: Get local grid boundaries
261: */
262: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
264: /*
265: Compute function over the locally owned part of the grid
266: */
267: cHeVCreate(&cHeV);
268: for (i=xs; i<xs+xm; i++) {
269: x = i*hx;
270: for (He=1; He<NHe+1; He++) c[i].He[He] = 0.0;
271: for (V=1; V<NV+1; V++) c[i].V[V] = 1.0;
272: for (I=1; I <NI+1; I++) c[i].I[I] = 1.0;
273: cHeVInitialize(&c[i].He[1],cHeV);
274: for (V=1; V<MHeV+1; V++) {
275: for (He=1; He<NHeV[V]+1; He++) cHeV[V][He] = 0.0;
276: }
277: }
278: cHeVDestroy(cHeV);
280: /*
281: Restore vectors
282: */
283: c = (Concentrations*)(((PetscScalar*)c)+1);
284: DMDAVecRestoreArray(da,C,&c);
285: return(0);
286: }
288: /* ------------------------------------------------------------------- */
291: /*
292: RHSFunction - Evaluates nonlinear function that defines the ODE
294: Input Parameters:
295: . ts - the TS context
296: . U - input vector
297: . ptr - optional user-defined context
299: Output Parameter:
300: . F - function values
301: */
302: PetscErrorCode RHSFunction(TS ts,PetscReal ftime,Vec C,Vec F,void *ptr)
303: {
304: AppCtx *ctx = (AppCtx*) ptr;
305: DM da;
307: PetscInt xi,Mx,xs,xm,He,he,V,v,I,i;
308: PetscReal hx,sx,x,**cHeV,**fHeV;
309: Concentrations *c,*f;
310: Vec localC;
313: TSGetDM(ts,&da);
314: DMGetLocalVector(da,&localC);
315: 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);
316: hx = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
317: cHeVCreate(&cHeV);
318: cHeVCreate(&fHeV);
320: /*
321: Scatter ghost points to local vector,using the 2-step process
322: DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
323: By placing code between these two statements, computations can be
324: done while messages are in transition.
325: */
326: DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
327: DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);
329: VecSet(F,0.0);
331: /*
332: Get pointers to vector data
333: */
334: DMDAVecGetArray(da,localC,&c);
335: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
336: c = (Concentrations*)(((PetscScalar*)c)-1);
337: DMDAVecGetArray(da,F,&f);
338: f = (Concentrations*)(((PetscScalar*)f)-1);
340: /*
341: Get local grid boundaries
342: */
343: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
345: /*
346: Loop over grid points computing ODE terms for each grid point
347: */
348: for (xi=xs; xi<xs+xm; xi++) {
349: x = xi*hx;
351: /* -------------------------------------------------------------
352: ---- Compute diffusion over the locally owned part of the grid
353: */
354: /* He clusters larger than 5 do not diffuse -- are immobile */
355: for (He=1; He<PetscMin(NHe+1,6); He++) {
356: f[xi].He[He] += ctx->HeDiffusion[He]*(-2.0*c[xi].He[He] + c[xi-1].He[He] + c[xi+1].He[He])*sx;
357: }
359: /* V and I clusters ONLY of size 1 diffuse */
360: f[xi].V[1] += ctx->VDiffusion[1]*(-2.0*c[xi].V[1] + c[xi-1].V[1] + c[xi+1].V[1])*sx;
361: f[xi].I[1] += ctx->IDiffusion[1]*(-2.0*c[xi].I[1] + c[xi-1].I[1] + c[xi+1].I[1])*sx;
363: /* Mixed He - V clusters are immobile */
365: /* ----------------------------------------------------------------
366: ---- Compute forcing that produces He of cluster size 1
367: Crude cubic approximation of graph from Tibo's notes
368: */
369: f[xi].He[1] += ctx->forcingScale*PetscMax(0.0,0.0006*x*x*x - 0.0087*x*x + 0.0300*x);
371: cHeVInitialize(&c[xi].He[1],cHeV);
372: cHeVInitialize(&f[xi].He[1],fHeV);
374: /* -------------------------------------------------------------------------
375: ---- Compute dissociation terms that removes an item from a cluster
376: I assume dissociation means losing only a single item from a cluster
377: I cannot tell from the notes if clusters can break up into any sub-size.
378: */
379: /* He[He] -> He[He-1] + He[1] */
380: for (He=2; He<NHe+1; He++) {
381: f[xi].He[He-1] += ctx->dissociationScale*c[xi].He[He];
382: f[xi].He[1] += ctx->dissociationScale*c[xi].He[He];
383: f[xi].He[He] -= ctx->dissociationScale*c[xi].He[He];
384: }
386: /* V[V] -> V[V-1] + V[1] */
387: for (V=2; V<NV+1; V++) {
388: f[xi].V[V-1] += ctx->dissociationScale*c[xi].V[V];
389: f[xi].V[1] += ctx->dissociationScale*c[xi].V[V];
390: f[xi].V[V] -= ctx->dissociationScale*c[xi].V[V];
391: }
393: /* I[I] -> I[I-1] + I[1] */
394: for (I=2; I<NI+1; I++) {
395: f[xi].I[I-1] += ctx->dissociationScale*c[xi].I[I];
396: f[xi].I[1] += ctx->dissociationScale*c[xi].I[I];
397: f[xi].I[I] -= ctx->dissociationScale*c[xi].I[I];
398: }
400: /* He[He]-V[1] -> He[He] + V[1] */
401: for (He=1; He<NHeV[1]+1; He++) {
402: f[xi].He[He] += 1000*ctx->dissociationScale*cHeV[1][He];
403: f[xi].V[1] += 1000*ctx->dissociationScale*cHeV[1][He];
404: fHeV[1][He] -= 1000*ctx->dissociationScale*cHeV[1][He];
405: }
407: /* He[1]-V[V] -> He[1] + V[V] */
408: for (V=2; V<MHeV+1; V++) {
409: f[xi].He[1] += 1000*ctx->dissociationScale*cHeV[V][1];
410: f[xi].V[V] += 1000*ctx->dissociationScale*cHeV[V][1];
411: fHeV[V][1] -= 1000*ctx->dissociationScale*cHeV[V][1];
412: }
414: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
415: for (V=2; V<MHeV+1; V++) {
416: for (He=2; He<NHeV[V]+1; He++) {
417: f[xi].He[1] += 1000*ctx->dissociationScale*cHeV[V][He];
418: fHeV[V][He-1] += 1000*ctx->dissociationScale*cHeV[V][He];
419: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
420: }
421: }
423: /* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
424: for (V=2; V<MHeV+1; V++) {
425: for (He=2; He<NHeV[V-1]+1; He++) {
426: f[xi].V[1] += 1000*ctx->dissociationScale*cHeV[V][He];
427: fHeV[V-1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
428: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
429: }
430: }
432: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
433: for (V=1; V<MHeV; V++) {
434: for (He=1; He<NHeV[V]+1; He++) {
435: fHeV[V+1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
436: f[xi].I[1] += 1000*ctx->dissociationScale*cHeV[V][He];
437: fHeV[V][He] -= 1000*ctx->dissociationScale*cHeV[V][He];
438: }
439: }
441: /* ----------------------------------------------------------------
442: ---- Compute reaction terms that can create a cluster of given size
443: */
444: /* He[He] + He[he] -> He[He+he] */
445: for (He=2; He<NHe+1; He++) {
446: /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
447: remove the upper half since they are symmetric to the lower half of the pairs. For example
448: when He = 5 (cluster size 5) the pairs are
449: 1 4
450: 2 2
451: 3 2 these last two are not needed in the sum since they repeat from above
452: 4 1 this is why he < (He/2) + 1 */
453: for (he=1; he<(He/2)+1; he++) {
454: f[xi].He[He] += ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
456: /* remove the two clusters that merged to form the larger cluster */
457: f[xi].He[he] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
458: f[xi].He[He-he] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
459: }
460: }
462: /* V[V] + V[v] -> V[V+v] */
463: for (V=2; V<NV+1; V++) {
464: for (v=1; v<(V/2)+1; v++) {
465: f[xi].V[V] += ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
466: f[xi].V[v] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
467: f[xi].V[V-v] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
468: }
469: }
471: /* I[I] + I[i] -> I[I+i] */
472: for (I=2; I<NI+1; I++) {
473: for (i=1; i<(I/2)+1; i++) {
474: f[xi].I[I] += ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
475: f[xi].I[i] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
476: f[xi].I[I-i] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
477: }
478: }
480: /* He[1] + V[1] -> He[1]-V[1] */
481: fHeV[1][1] += 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
482: f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
483: f[xi].V[1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
485: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
486: for (V=1; V<MHeV+1; V++) {
487: for (He=1; He<NHeV[V]; He++) {
488: for (he=1; he+He<NHeV[V]+1; he++) {
489: fHeV[V][He+he] += ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
490: f[xi].He[he] -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
491: fHeV[V][He] -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
492: }
493: }
494: }
496: /* He[He]-V[V] + V[1] -> He[He][V+1] */
497: for (V=1; V<MHeV; V++) {
498: for (He=1; He<NHeV[V+1]; He++) {
499: fHeV[V+1][He] += ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
500: /* remove the two clusters that merged to form the larger cluster */
501: f[xi].V[1] -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
502: fHeV[V][He] -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
503: }
504: }
506: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
507: /* Currently the reaction rates for this are zero */
510: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
511: for (V=1; V<NV+1; V++) {
512: for (I=1; I<PetscMin(V,NI); I++) {
513: f[xi].V[V-I] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
514: f[xi].V[V] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
515: f[xi].I[I] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
516: }
517: for (I=V+1; I<NI+1; I++) {
518: f[xi].I[I-V] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
519: f[xi].V[V] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
520: f[xi].I[I] -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
521: }
522: }
523: }
525: /*
526: Restore vectors
527: */
528: c = (Concentrations*)(((PetscScalar*)c)+1);
529: DMDAVecRestoreArray(da,localC,&c);
530: f = (Concentrations*)(((PetscScalar*)f)+1);
531: DMDAVecRestoreArray(da,F,&f);
532: DMRestoreLocalVector(da,&localC);
533: cHeVDestroy(cHeV);
534: cHeVDestroy(fHeV);
535: return(0);
536: }
540: /*
541: Compute the Jacobian entries based on IFuction() and insert them into the matrix
542: */
543: PetscErrorCode RHSJacobian(TS ts,PetscReal ftime,Vec C,Mat *A,Mat *J,MatStructure *str,void *ptr)
544: {
545: AppCtx *ctx = (AppCtx*) ptr;
546: DM da;
547: PetscErrorCode ierr;
548: PetscInt xi,Mx,xs,xm,He,he,V,v,I,i;
549: PetscInt row[3],col[3];
550: PetscReal hx,sx,x,val[6];
551: const Concentrations *c,*f;
552: Vec localC;
553: const PetscReal *rowstart,*colstart;
554: const PetscReal **cHeV,**fHeV;
555: static PetscBool initialized = PETSC_FALSE;
558: cHeVCreate((PetscScalar***)&cHeV);
559: cHeVCreate((PetscScalar***)&fHeV);
560: MatZeroEntries(*J);
561: TSGetDM(ts,&da);
562: DMGetLocalVector(da,&localC);
563: 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);
564: hx = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
566: DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
567: DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);
569: /*
570: The f[] is dummy, values are never set into it. It is only used to determine the
571: local row for the entries in the Jacobian
572: */
573: DMDAVecGetArray(da,localC,&c);
574: /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
575: c = (Concentrations*)(((PetscScalar*)c)-1);
576: DMDAVecGetArray(da,C,&f);
577: f = (Concentrations*)(((PetscScalar*)f)-1);
579: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
581: rowstart = &f[xs].He[1] - DOF;
582: colstart = &c[xs-1].He[1];
584: if (!initialized) {
585: /*
586: Loop over grid points computing Jacobian terms for each grid point
587: */
588: for (xi=xs; xi<xs+xm; xi++) {
589: x = xi*hx;
590:
591: cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
592: cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
593:
594: /* -------------------------------------------------------------
595: ---- Compute diffusion over the locally owned part of the grid
596: */
597: /* He clusters larger than 5 do not diffuse -- are immobile */
598: for (He=1; He<PetscMin(NHe+1,6); He++) {
599: row[0] = &f[xi].He[He] - rowstart;
600: col[0] = &c[xi-1].He[He] - colstart;
601: col[1] = &c[xi].He[He] - colstart;
602: col[2] = &c[xi+1].He[He] - colstart;
603: val[0] = ctx->HeDiffusion[He]*sx;
604: val[1] = -2.0*ctx->HeDiffusion[He]*sx;
605: val[2] = ctx->HeDiffusion[He]*sx;
606: MatSetValuesLocal(*J,1,row,3,col,val,ADD_VALUES);
607: }
609: /* V and I clusters ONLY of size 1 diffuse */
610: row[0] = &f[xi].V[1] - rowstart;
611: col[0] = &c[xi-1].V[1] - colstart;
612: col[1] = &c[xi].V[1] - colstart;
613: col[2] = &c[xi+1].V[1] - colstart;
614: val[0] = ctx->VDiffusion[1]*sx;
615: val[1] = -2.0*ctx->VDiffusion[1]*sx;
616: val[2] = ctx->VDiffusion[1]*sx;
617: MatSetValuesLocal(*J,1,row,3,col,val,ADD_VALUES);
618:
619: row[0] = &f[xi].I[1] - rowstart;
620: col[0] = &c[xi-1].I[1] - colstart;
621: col[1] = &c[xi].I[1] - colstart;
622: col[2] = &c[xi+1].I[1] - colstart;
623: val[0] = ctx->IDiffusion[1]*sx;
624: val[1] = -2.0*ctx->IDiffusion[1]*sx;
625: val[2] = ctx->IDiffusion[1]*sx;
626: MatSetValuesLocal(*J,1,row,3,col,val,ADD_VALUES);
627:
628: /* Mixed He - V clusters are immobile */
629:
630: /* -------------------------------------------------------------------------
631: ---- Compute dissociation terms that removes an item from a cluster
632: I assume dissociation means losing only a single item from a cluster
633: I cannot tell from the notes if clusters can break up into any sub-size.
634: */
635:
636: /* He[He] -> He[He-1] + He[1] */
637: for (He=2; He<NHe+1; He++) {
638: row[0] = &f[xi].He[He-1] - rowstart;
639: row[1] = &f[xi].He[1] - rowstart;
640: row[2] = &f[xi].He[He] - rowstart;
641: col[0] = &c[xi].He[He] - colstart;
642: val[0] = ctx->dissociationScale;
643: val[1] = ctx->dissociationScale;
644: val[2] = -ctx->dissociationScale;
645: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
646: }
647:
648: /* V[V] -> V[V-1] + V[1] */
649: for (V=2; V<NV+1; V++) {
650: row[0] = &f[xi].V[V-1] - rowstart;
651: row[1] = &f[xi].V[1] - rowstart;
652: row[2] = &f[xi].V[V] - rowstart;
653: col[0] = &c[xi].V[V] - colstart;
654: val[0] = ctx->dissociationScale;
655: val[1] = ctx->dissociationScale;
656: val[2] = -ctx->dissociationScale;
657: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
658: }
659:
660: /* I[I] -> I[I-1] + I[1] */
661: for (I=2; I<NI+1; I++) {
662: row[0] = &f[xi].I[I-1] - rowstart;
663: row[1] = &f[xi].I[1] - rowstart;
664: row[2] = &f[xi].I[I] - rowstart;
665: col[0] = &c[xi].I[I] - colstart;
666: val[0] = ctx->dissociationScale;
667: val[1] = ctx->dissociationScale;
668: val[2] = -ctx->dissociationScale;
669: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
670: }
671:
672: /* He[He]-V[1] -> He[He] + V[1] */
673: for (He=1; He<NHeV[1]+1; He++) {
674: row[0] = &f[xi].He[He] - rowstart;
675: row[1] = &f[xi].V[1] - rowstart;
676: row[2] = &fHeV[1][He] - rowstart;
677: col[0] = &cHeV[1][He] - colstart;
678: val[0] = 1000*ctx->dissociationScale;
679: val[1] = 1000*ctx->dissociationScale;
680: val[2] = -1000*ctx->dissociationScale;
681: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
682: }
683:
684: /* He[1]-V[V] -> He[1] + V[V] */
685: for (V=2; V<MHeV+1; V++) {
686: row[0] = &f[xi].He[1] - rowstart;
687: row[1] = &f[xi].V[V] - rowstart;
688: row[2] = &fHeV[V][1] - rowstart;
689: col[0] = &cHeV[V][1] - colstart;
690: val[0] = 1000*ctx->dissociationScale;
691: val[1] = 1000*ctx->dissociationScale;
692: val[2] = -1000*ctx->dissociationScale;
693: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
694: }
695:
696: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
697: for (V=2; V<MHeV+1; V++) {
698: for (He=2; He<NHeV[V]+1; He++) {
699: row[0] = &f[xi].He[1] - rowstart;
700: row[1] = &fHeV[V][He-1] - rowstart;
701: row[2] = &fHeV[V][He] - rowstart;
702: col[0] = &cHeV[V][He] - colstart;
703: val[0] = 1000*ctx->dissociationScale;
704: val[1] = 1000*ctx->dissociationScale;
705: val[2] = -1000*ctx->dissociationScale;
706: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
707: }
708: }
709:
710: /* He[He]-V[V] -> He[He]-V[V-1] + V[1] */
711: for (V=2; V<MHeV+1; V++) {
712: for (He=2; He<NHeV[V-1]+1; He++) {
713: row[0] = &f[xi].V[1] - rowstart;
714: row[1] = &fHeV[V-1][He] - rowstart;
715: row[2] = &fHeV[V][He] - rowstart;
716: col[0] = &cHeV[V][He] - colstart;
717: val[0] = 1000*ctx->dissociationScale;
718: val[1] = 1000*ctx->dissociationScale;
719: val[2] = -1000*ctx->dissociationScale;
720: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
721: }
722: }
723:
724: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
725: for (V=1; V<MHeV; V++) {
726: for (He=1; He<NHeV[V]+1; He++) {
727: row[0] = &fHeV[V+1][He] - rowstart;
728: row[1] = &f[xi].I[1] - rowstart;
729: row[2] = &fHeV[V][He] - rowstart;
730: col[0] = &cHeV[V][He] - colstart;
731: val[0] = 1000*ctx->dissociationScale;
732: val[1] = 1000*ctx->dissociationScale;
733: val[2] = -1000*ctx->dissociationScale;
734: MatSetValuesLocal(*J,3,row,1,col,val,ADD_VALUES);
735: }
736: }
737: }
738: MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
739: MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
740: MatSetOption(*J,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
741: MatStoreValues(*J);
742: MatSetFromOptions(*J);
743: initialized = PETSC_TRUE;
744: } else {
745: MatRetrieveValues(*J);
746: }
748: /*
749: Loop over grid points computing Jacobian terms for each grid point for reaction terms
750: */
751: for (xi=xs; xi<xs+xm; xi++) {
752: x = xi*hx;
753: cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
754: cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
755: /* ----------------------------------------------------------------
756: ---- Compute reaction terms that can create a cluster of given size
757: */
758: /* He[He] + He[he] -> He[He+he] */
759: for (He=2; He<NHe+1; He++) {
760: /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
761: remove the upper half since they are symmetric to the lower half of the pairs. For example
762: when He = 5 (cluster size 5) the pairs are
763: 1 4
764: 2 2
765: 3 2 these last two are not needed in the sum since they repeat from above
766: 4 1 this is why he < (He/2) + 1 */
767: for (he=1; he<(He/2)+1; he++) {
768: row[0] = &f[xi].He[He] - rowstart;
769: row[1] = &f[xi].He[he] - rowstart;
770: row[2] = &f[xi].He[He-he] - rowstart;
771: col[0] = &c[xi].He[he] - colstart;
772: col[1] = &c[xi].He[He-he] - colstart;
773: val[0] = ctx->reactionScale*c[xi].He[He-he];
774: val[1] = ctx->reactionScale*c[xi].He[he];
775: val[2] = -ctx->reactionScale*c[xi].He[He-he];
776: val[3] = -ctx->reactionScale*c[xi].He[he];
777: val[4] = -ctx->reactionScale*c[xi].He[He-he];
778: val[5] = -ctx->reactionScale*c[xi].He[he];
779: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
780: }
781: }
783: /* V[V] + V[v] -> V[V+v] */
784: for (V=2; V<NV+1; V++) {
785: for (v=1; v<(V/2)+1; v++) {
786: row[0] = &f[xi].V[V] - rowstart;
787: row[1] = &f[xi].V[v] - rowstart;
788: row[2] = &f[xi].V[V-v] - rowstart;
789: col[0] = &c[xi].V[v] - colstart;
790: col[1] = &c[xi].V[V-v] - colstart;
791: val[0] = ctx->reactionScale*c[xi].V[V-v];
792: val[1] = ctx->reactionScale*c[xi].V[v];
793: val[2] = -ctx->reactionScale*c[xi].V[V-v];
794: val[3] = -ctx->reactionScale*c[xi].V[v];
795: val[4] = -ctx->reactionScale*c[xi].V[V-v];
796: val[5] = -ctx->reactionScale*c[xi].V[v];
797: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
798: }
799: }
801: /* I[I] + I[i] -> I[I+i] */
802: for (I=2; I<NI+1; I++) {
803: for (i=1; i<(I/2)+1; i++) {
804: row[0] = &f[xi].I[I] - rowstart;
805: row[1] = &f[xi].I[i] - rowstart;
806: row[2] = &f[xi].I[I-i] - rowstart;
807: col[0] = &c[xi].I[i] - colstart;
808: col[1] = &c[xi].I[I-i] - colstart;
809: val[0] = ctx->reactionScale*c[xi].I[I-i];
810: val[1] = ctx->reactionScale*c[xi].I[i];
811: val[2] = -ctx->reactionScale*c[xi].I[I-i];
812: val[3] = -ctx->reactionScale*c[xi].I[i];
813: val[4] = -ctx->reactionScale*c[xi].I[I-i];
814: val[5] = -ctx->reactionScale*c[xi].I[i];
815: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
816: }
817: }
819: /* He[1] + V[1] -> He[1]-V[1] */
820: row[0] = &fHeV[1][1] - rowstart;
821: row[1] = &f[xi].He[1] - rowstart;
822: row[2] = &f[xi].V[1] - rowstart;
823: col[0] = &c[xi].He[1] - colstart;
824: col[1] = &c[xi].V[1] - colstart;
825: val[0] = 1000*ctx->reactionScale*c[xi].V[1];
826: val[1] = 1000*ctx->reactionScale*c[xi].He[1];
827: val[2] = -1000*ctx->reactionScale*c[xi].V[1];
828: val[3] = -1000*ctx->reactionScale*c[xi].He[1];
829: val[4] = -1000*ctx->reactionScale*c[xi].V[1];
830: val[5] = -1000*ctx->reactionScale*c[xi].He[1];
831: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
833: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
834: for (V=1; V<MHeV+1; V++) {
835: for (He=1; He<NHeV[V]; He++) {
836: for (he=1; he+He<NHeV[V]+1; he++) {
837: row[0] = &fHeV[V][He+he] - rowstart;
838: row[1] = &f[xi].He[he] - rowstart;
839: row[2] = &fHeV[V][He] - rowstart;
840: col[0] = &c[xi].He[he] - colstart;
841: col[1] = &cHeV[V][He] - colstart;
842: val[0] = ctx->reactionScale*cHeV[V][He];
843: val[1] = ctx->reactionScale*c[xi].He[he];
844: val[2] = -ctx->reactionScale*cHeV[V][He];
845: val[3] = -ctx->reactionScale*c[xi].He[he];
846: val[4] = -ctx->reactionScale*cHeV[V][He];
847: val[5] = -ctx->reactionScale*c[xi].He[he];
848: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
849: }
850: }
851: }
853: /* He[He]-V[V] + V[1] -> He[He][V+1] */
854: for (V=1; V<MHeV; V++) {
855: for (He=1; He<NHeV[V+1]; He++) {
856: row[0] = &fHeV[V+1][He] - rowstart;
857: row[1] = &f[xi].V[1] - rowstart;
858: row[2] = &fHeV[V][He] - rowstart;
859: col[0] = &c[xi].V[1] - colstart;
860: col[1] = &cHeV[V][He] - colstart;
861: val[0] = ctx->reactionScale*cHeV[V][He];
862: val[1] = ctx->reactionScale*c[xi].V[1];
863: val[2] = -ctx->reactionScale*cHeV[V][He];
864: val[3] = -ctx->reactionScale*c[xi].V[1];
865: val[4] = -ctx->reactionScale*cHeV[V][He];
866: val[5] = -ctx->reactionScale*c[xi].V[1];
867: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
868: }
869: }
871: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
872: /* Currently the reaction rates for this are zero */
875: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
876: for (V=1; V<NV+1; V++) {
877: for (I=1; I<PetscMin(V,NI); I++) {
878: row[0] = &f[xi].V[V-I] - rowstart;
879: row[1] = &f[xi].V[V] - rowstart;
880: row[2] = &f[xi].I[I] - rowstart;
881: col[0] = &c[xi].V[V] - colstart;
882: col[1] = &c[xi].I[I] - colstart;
883: val[0] = ctx->reactionScale*c[xi].I[I];
884: val[1] = ctx->reactionScale*c[xi].V[V];
885: val[2] = -ctx->reactionScale*c[xi].I[I];
886: val[3] = -ctx->reactionScale*c[xi].V[V];
887: val[4] = -ctx->reactionScale*c[xi].I[I];
888: val[5] = -ctx->reactionScale*c[xi].V[V];
889: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
890: }
891: for (I=V+1; I<NI+1; I++) {
892: row[0] = &f[xi].I[I-V] - rowstart;
893: row[1] = &f[xi].V[V] - rowstart;
894: row[2] = &f[xi].I[I] - rowstart;
895: col[0] = &c[xi].V[V] - colstart;
896: col[1] = &c[xi].I[I] - colstart;
897: val[0] = ctx->reactionScale*c[xi].I[I];
898: val[1] = ctx->reactionScale*c[xi].V[V];
899: val[2] = -ctx->reactionScale*c[xi].I[I];
900: val[3] = -ctx->reactionScale*c[xi].V[V];
901: val[4] = -ctx->reactionScale*c[xi].I[I];
902: val[5] = -ctx->reactionScale*c[xi].V[V];
903: MatSetValuesLocal(*J,3,row,2,col,val,ADD_VALUES);
904: }
905: }
906: }
908: /*
909: Restore vectors
910: */
911: c = (Concentrations*)(((PetscScalar*)c)+1);
912: DMDAVecRestoreArray(da,localC,&c);
913: f = (Concentrations*)(((PetscScalar*)f)+1);
914: DMDAVecRestoreArray(da,C,&f);
915: DMRestoreLocalVector(da,&localC);
916: cHeVDestroy((PetscScalar**)cHeV);
917: cHeVDestroy((PetscScalar**)fHeV);
919: *str = SAME_NONZERO_PATTERN;
920: MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
921: MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
922: if (*A != *J) {
923: MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY);
924: MatAssemblyEnd(*A,MAT_FINAL_ASSEMBLY);
925: }
926: return(0);
927: }
931: /*
932: Determines the nonzero structure within the diagonal blocks of the Jacobian that represent coupling resulting from reactions and
933: dissasociations of the clusters
934: */
935: PetscErrorCode GetDfill(PetscInt *dfill, void *ptr)
936: {
937: PetscInt He,he,V,v,I,i,j,k,rows[3],cols[2];
938: Concentrations *c;
939: PetscScalar *idxstart,**cHeV;
942: /* ensure fill for the diagonal of matrix */
943: for (i=0; i<(DOF); i++) {
944: dfill[i*DOF + i] = 1;
945: }
947: /*
948: c is never used except for computing offsets between variables which are used to fill the non-zero
949: structure of the matrix
950: */
951: PetscMalloc(sizeof(Concentrations),&c);
952: c = (Concentrations*)(((PetscScalar*)c)-1);
953: cHeVCreate(&cHeV);
954: cHeVInitialize(&c->He[1],cHeV);
955: idxstart = (PetscScalar*)&c->He[1];
957: /* -------------------------------------------------------------------------
958: ---- Compute dissociation terms that removes an item from a cluster
959: I assume dissociation means losing only a single item from a cluster
960: I cannot tell from the notes if clusters can break up into any sub-size.
961: */
962: /* He[He] -> He[He-1] + He[1] */
963: for (He=2; He<NHe+1; He++) {
964: rows[0] = &c->He[He-1] - idxstart;
965: rows[1] = &c->He[1] - idxstart;
966: rows[2] = &c->He[He] - idxstart;
967: cols[0] = &c->He[He] - idxstart;
968: for (j=0; j<3; j++) {
969: dfill[rows[j]*DOF + cols[0]] = 1;
970: }
971: }
973: /* V[V] -> V[V-1] + V[1] */
974: for (V=2; V<NV+1; V++) {
975: rows[0] = &c->V[V] - idxstart;
976: rows[1] = &c->V[1] - idxstart;
977: rows[2] = &c->V[V-1] - idxstart;
978: cols[0] = &c->V[V] - idxstart;
979: for (j=0; j<3; j++) {
980: dfill[rows[j]*DOF + cols[0]] = 1;
981: }
982: }
983:
984: /* I[I] -> I[I-1] + I[1] */
985: for (I=2; I<NI+1; I++) {
986: rows[0] = &c->I[I] - idxstart;
987: rows[1] = &c->I[1] - idxstart;
988: rows[2] = &c->I[I-1] - idxstart;
989: cols[0] = &c->I[I] - idxstart;
990: for (j=0; j<3; j++) {
991: dfill[rows[j]*DOF + cols[0]] = 1;
992: }
993: }
994:
995: /* He[He]-V[1] -> He[He] + V[1] */
996: for (He=1; He<NHeV[1]+1; He++) {
997: rows[0] = &c->He[He] - idxstart;
998: rows[1] = &c->V[1] - idxstart;
999: rows[2] = &cHeV[1][He] - idxstart;
1000: cols[0] = &cHeV[1][He] - idxstart;
1001: for (j=0; j<3; j++) {
1002: dfill[rows[j]*DOF + cols[0]] = 1;
1003: }
1004: }
1005:
1006: /* He[1]-V[V] -> He[1] + V[V] */
1007: for (V=2; V<MHeV+1; V++) {
1008: rows[0] = &c->He[1] - idxstart;
1009: rows[1] = &c->V[V] - idxstart;
1010: rows[2] = &cHeV[V][1] - idxstart;
1011: cols[0] = &cHeV[V][1] - idxstart;
1012: for (j=0; j<3; j++) {
1013: dfill[rows[j]*DOF + cols[0]] = 1;
1014: }
1015: }
1016:
1017: /* He[He]-V[V] -> He[He-1]-V[V] + He[1] */
1018: for (V=2; V<MHeV+1; V++) {
1019: for (He=2; He<NHeV[V]+1; He++) {
1020: rows[0] = &c->He[1] - idxstart;
1021: rows[1] = &cHeV[V][He] - idxstart;
1022: rows[2] = &cHeV[V][He-1] - 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] + V[1] */
1031: for (V=2; V<MHeV+1; V++) {
1032: for (He=2; He<NHeV[V-1]+1; He++) {
1033: rows[0] = &c->V[1] - idxstart;
1034: rows[1] = &cHeV[V][He] - idxstart;
1035: rows[2] = &cHeV[V-1][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: }
1042:
1043: /* He[He]-V[V] -> He[He]-V[V+1] + I[1] */
1044: for (V=1; V<MHeV; V++) {
1045: for (He=1; He<NHeV[V]+1; He++) {
1046: rows[0] = &c->I[1] - idxstart;
1047: rows[1] = &cHeV[V+1][He] - idxstart;
1048: rows[2] = &cHeV[V][He] - idxstart;
1049: cols[0] = &cHeV[V][He] - idxstart;
1050: for (j=0; j<3; j++) {
1051: dfill[rows[j]*DOF + cols[0]] = 1;
1052: }
1053: }
1054: }
1056: /* These are the reaction terms in the diagonal block */
1057: for (He=2; He<NHe+1; He++) {
1058: for (he=1; he<(He/2)+1; he++) {
1059: rows[0] = &c->He[He] - idxstart;
1060: rows[1] = &c->He[he] - idxstart;
1061: rows[2] = &c->He[He-he] - idxstart;
1062: cols[0] = &c->He[he] - idxstart;
1063: cols[1] = &c->He[He-he] - idxstart;
1064: for (j=0; j<3; j++) {
1065: for (k=0; k<2; k++) {
1066: dfill[rows[j]*DOF + cols[k]] = 1;
1067: }
1068: }
1069: }
1070: }
1072: /* V[V] + V[v] -> V[V+v] */
1073: for (V=2; V<NV+1; V++) {
1074: for (v=1; v<(V/2)+1; v++) {
1075: rows[0] = &c->V[V] - idxstart;
1076: rows[1] = &c->V[v] - idxstart;
1077: rows[2] = &c->V[V-v] - idxstart;
1078: cols[0] = &c->V[v] - idxstart;
1079: cols[1] = &c->V[V-v] - idxstart;
1080: for (j=0; j<3; j++) {
1081: for (k=0; k<2; k++) {
1082: dfill[rows[j]*DOF + cols[k]] = 1;
1083: }
1084: }
1085: }
1086: }
1087:
1088: /* I[I] + I[i] -> I[I+i] */
1089: for (I=2; I<NI+1; I++) {
1090: for (i=1; i<(I/2)+1; i++) {
1091: rows[0] = &c->I[I] - idxstart;
1092: rows[1] = &c->I[i] - idxstart;
1093: rows[2] = &c->I[I-i] - idxstart;
1094: cols[0] = &c->I[i] - idxstart;
1095: cols[1] = &c->I[I-i] - idxstart;
1096: for (j=0; j<3; j++) {
1097: for (k=0; k<2; k++) {
1098: dfill[rows[j]*DOF + cols[k]] = 1;
1099: }
1100: }
1101: }
1102: }
1103:
1104: /* He[1] + V[1] -> He[1]-V[1] */
1105: rows[0] = &cHeV[1][1] - idxstart;
1106: rows[1] = &c->He[1] - idxstart;
1107: rows[2] = &c->V[1] - idxstart;
1108: cols[0] = &c->He[1] - idxstart;
1109: cols[1] = &c->V[1] - idxstart;
1110: for (j=0; j<3; j++) {
1111: for (k=0; k<2; k++) {
1112: dfill[rows[j]*DOF + cols[k]] = 1;
1113: }
1114: }
1115:
1116: /* He[He]-V[V] + He[he] -> He[He+he]-V[V] */
1117: for (V=1; V<MHeV+1; V++) {
1118: for (He=1; He<NHeV[V]; He++) {
1119: for (he=1; he+He<NHeV[V]+1; he++) {
1120: rows[0] = &cHeV[V][He+he] - idxstart;
1121: rows[1] = &c->He[he] - idxstart;
1122: rows[2] = &cHeV[V][He] - idxstart;
1123: cols[0] = &cHeV[V][He] - idxstart;
1124: cols[1] = &c->He[he] - idxstart;
1125: for (j=0; j<3; j++) {
1126: for (k=0; k<2; k++) {
1127: dfill[rows[j]*DOF + cols[k]] = 1;
1128: }
1129: }
1130: }
1131: }
1132: }
1133: /* He[He]-V[V] + V[1] -> He[He][V+1] */
1134: for (V=1; V<MHeV; V++) {
1135: for (He=1; He<NHeV[V+1]; He++) {
1136: rows[0] = &cHeV[V+1][He] - idxstart;
1137: rows[1] = &c->V[1] - idxstart;
1138: rows[2] = &cHeV[V][He] - idxstart;
1139: cols[0] = &cHeV[V][He] - idxstart;
1140: cols[1] = &c->V[1] - idxstart;
1141: for (j=0; j<3; j++) {
1142: for (k=0; k<2; k++) {
1143: dfill[rows[j]*DOF + cols[k]] = 1;
1144: }
1145: }
1146: }
1147: }
1149: /* He[He]-V[V] + He[he]-V[v] -> He[He+he][V+v] */
1150: /* Currently the reaction rates for this are zero */
1151:
1152: /* V[V] + I[I] -> V[V-I] if V > I else I[I-V] */
1153: for (V=1; V<NV+1; V++) {
1154: for (I=1; I<PetscMin(V,NI); I++) {
1155: rows[0] = &c->V[V-I] - idxstart;
1156: rows[1] = &c->V[V] - idxstart;
1157: rows[2] = &c->I[I] - idxstart;
1158: cols[0] = &c->V[V] - idxstart;
1159: cols[1] = &c->I[I] - idxstart;
1160: for (j=0; j<3; j++) {
1161: for (k=0; k<2; k++) {
1162: dfill[rows[j]*DOF + cols[k]] = 1;
1163: }
1164: }
1165: }
1166: for (I=V+1; I<NI+1; I++) {
1167: rows[0] = &c->I[I-V] - idxstart;
1168: rows[1] = &c->V[V] - idxstart;
1169: rows[2] = &c->I[I] - idxstart;
1170: cols[0] = &c->V[V] - idxstart;
1171: cols[1] = &c->I[I] - idxstart;
1172: for (j=0; j<3; j++) {
1173: for (k=0; k<2; k++) {
1174: dfill[rows[j]*DOF + cols[k]] = 1;
1175: }
1176: }
1177: }
1178: }
1180: c = (Concentrations*)(((PetscScalar*)c)+1);
1181: cHeVDestroy(cHeV);
1182: PetscFree(c);
1183: return(0);
1184: }
1185: /* ------------------------------------------------------------------- */
1187: typedef struct {
1188: DM Heda,Vda,HeVda; /* defines the 2d layout of the He subvector */
1189: Vec He,V,HeV;
1190: VecScatter Hescatter,Vscatter,HeVscatter;
1191: PetscViewer Heviewer,Vviewer,HeVviewer;
1192: } MyMonitorCtx;
1196: /*
1197: Display He as a function of space and cluster size for each time step
1198: */
1199: PetscErrorCode MyMonitorMonitor(TS ts,PetscInt timestep,PetscReal time,Vec solution, void *ictx)
1200: {
1201: MyMonitorCtx *ctx = (MyMonitorCtx*)ictx;
1205: VecScatterBegin(ctx->Hescatter,solution,ctx->He,INSERT_VALUES,SCATTER_FORWARD);
1206: VecScatterEnd(ctx->Hescatter,solution,ctx->He,INSERT_VALUES,SCATTER_FORWARD);
1207: VecView(ctx->He,ctx->Heviewer);
1209: VecScatterBegin(ctx->Vscatter,solution,ctx->V,INSERT_VALUES,SCATTER_FORWARD);
1210: VecScatterEnd(ctx->Vscatter,solution,ctx->V,INSERT_VALUES,SCATTER_FORWARD);
1211: VecView(ctx->V,ctx->Vviewer);
1213: VecScatterBegin(ctx->HeVscatter,solution,ctx->HeV,INSERT_VALUES,SCATTER_FORWARD);
1214: VecScatterEnd(ctx->HeVscatter,solution,ctx->HeV,INSERT_VALUES,SCATTER_FORWARD);
1215: VecView(ctx->HeV,ctx->HeVviewer);
1216: return(0);
1217: }
1221: /*
1222: Frees all data structures associated with the monitor
1223: */
1224: PetscErrorCode MyMonitorDestroy(void **ictx)
1225: {
1226: MyMonitorCtx **ctx = (MyMonitorCtx**)ictx;
1230: VecScatterDestroy(&(*ctx)->Hescatter);
1231: VecDestroy(&(*ctx)->He);
1232: DMDestroy(&(*ctx)->Heda);
1233: PetscViewerDestroy(&(*ctx)->Heviewer);
1235: VecScatterDestroy(&(*ctx)->Vscatter);
1236: VecDestroy(&(*ctx)->V);
1237: DMDestroy(&(*ctx)->Vda);
1238: PetscViewerDestroy(&(*ctx)->Vviewer);
1240: VecScatterDestroy(&(*ctx)->HeVscatter);
1241: VecDestroy(&(*ctx)->HeV);
1242: DMDestroy(&(*ctx)->HeVda);
1243: PetscViewerDestroy(&(*ctx)->HeVviewer);
1244: PetscFree(*ctx);
1245: return(0);
1246: }
1250: /*
1251: Sets up a monitor that will display He as a function of space and cluster size for each time step
1252: */
1253: PetscErrorCode MyMonitorSetUp(TS ts)
1254: {
1255: DM da;
1257: PetscInt xi,xs,xm,*idx,M,xj,cnt = 0;
1258: const PetscInt *lx;
1259: Vec C;
1260: MyMonitorCtx *ctx;
1261: PetscBool flg;
1262: IS is;
1263: char ycoor[32];
1264: PetscReal valuebounds[4] = {0, 1.2, 0, 1.2};
1267: PetscOptionsHasName(NULL,"-mymonitor",&flg);
1268: if (!flg) return(0);
1270: TSGetDM(ts,&da);
1271: PetscNew(MyMonitorCtx,&ctx);
1272: PetscNew(&ctx);
1273: PetscViewerDrawOpen(PetscObjectComm((PetscObject)da),NULL,"",PETSC_DECIDE,PETSC_DECIDE,600,400,&ctx->viewer);
1275: /* setup visualization for He */
1276: PetscViewerDrawOpen(PetscObjectComm((PetscObject)da),NULL,"",PETSC_DECIDE,PETSC_DECIDE,600,400,&ctx->Heviewer);
1277: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
1278: DMDAGetInfo(da,PETSC_IGNORE,&M,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
1279: DMDAGetOwnershipRanges(da,&lx,NULL,NULL);
1280: DMDACreate2d(PetscObjectComm((PetscObject)da),DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,M,NHe,PETSC_DETERMINE,1,1,1,lx,NULL,&ctx->Heda);
1281: DMDASetFieldName(ctx->Heda,0,"He");
1282: DMDASetCoordinateName(ctx->Heda,0,"X coordinate direction");
1283: PetscSNPrintf(ycoor,32,"%D ... Cluster size ... 1",NHe);
1284: DMDASetCoordinateName(ctx->Heda,1,ycoor);
1285: DMCreateGlobalVector(ctx->Heda,&ctx->He);
1286: PetscMalloc(NHe*xm*sizeof(PetscInt),&idx);
1287: cnt = 0;
1288: for (xj=0; xj<NHe; xj++) {
1289: for (xi=xs; xi<xs+xm; xi++) {
1290: idx[cnt++] = DOF*xi + xj;
1291: }
1292: }
1293: ISCreateGeneral(PetscObjectComm((PetscObject)ts),NHe*xm,idx,PETSC_OWN_POINTER,&is);
1294: TSGetSolution(ts,&C);
1295: VecScatterCreate(C,is,ctx->He,NULL,&ctx->Hescatter);
1296: ISDestroy(&is);
1297: /* sets the bounds on the contour plot values so the colors mean the same thing for different timesteps */
1298: PetscViewerDrawSetBounds(ctx->Heviewer,2,valuebounds);
1300: /* setup visualization for V */
1301: PetscViewerDrawOpen(PetscObjectComm((PetscObject)da),NULL,"",PETSC_DECIDE,PETSC_DECIDE,600,400,&ctx->Vviewer);
1302: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
1303: DMDAGetInfo(da,PETSC_IGNORE,&M,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
1304: DMDAGetOwnershipRanges(da,&lx,NULL,NULL);
1305: DMDACreate2d(PetscObjectComm((PetscObject)da),DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,M,NV,PETSC_DETERMINE,1,1,1,lx,NULL,&ctx->Vda);
1306: DMDASetFieldName(ctx->Vda,0,"V");
1307: DMDASetCoordinateName(ctx->Vda,0,"X coordinate direction");
1308: PetscSNPrintf(ycoor,32,"%D ... Cluster size ... 1",NV);
1309: DMDASetCoordinateName(ctx->Vda,1,ycoor);
1310: DMCreateGlobalVector(ctx->Vda,&ctx->V);
1311: PetscMalloc(NV*xm*sizeof(PetscInt),&idx);
1312: DMCreateGlobalVector(ctx->da,&ctx->He);
1313: PetscMalloc1(2*N*xm,&idx);
1314: cnt = 0;
1315: for (xj=0; xj<NV; xj++) {
1316: for (xi=xs; xi<xs+xm; xi++) {
1317: idx[cnt++] = NHe + DOF*xi + xj;
1318: }
1319: }
1320: ISCreateGeneral(PetscObjectComm((PetscObject)ts),NV*xm,idx,PETSC_OWN_POINTER,&is);
1321: TSGetSolution(ts,&C);
1322: VecScatterCreate(C,is,ctx->V,NULL,&ctx->Vscatter);
1323: ISDestroy(&is);
1324: /* sets the bounds on the contour plot values so the colors mean the same thing for different timesteps */
1325: PetscViewerDrawSetBounds(ctx->Vviewer,2,valuebounds);
1327: /* setup visualization for HeV[1][] */
1328: PetscViewerDrawOpen(PetscObjectComm((PetscObject)da),NULL,"",PETSC_DECIDE,PETSC_DECIDE,600,400,&ctx->HeVviewer);
1329: DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);
1330: DMDAGetInfo(da,PETSC_IGNORE,&M,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
1331: DMDAGetOwnershipRanges(da,&lx,NULL,NULL);
1332: DMDACreate2d(PetscObjectComm((PetscObject)da),DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,M,NHeV[1],PETSC_DETERMINE,1,1,1,lx,NULL,&ctx->HeVda);
1333: DMDASetFieldName(ctx->HeVda,0,"HeV[1][]");
1334: DMDASetCoordinateName(ctx->HeVda,0,"X coordinate direction");
1335: PetscSNPrintf(ycoor,32,"%D ... Cluster size ... 1",NHeV[1]);
1336: DMDASetCoordinateName(ctx->HeVda,1,ycoor);
1337: DMCreateGlobalVector(ctx->HeVda,&ctx->HeV);
1338: PetscMalloc(NHeV[1]*xm*sizeof(PetscInt),&idx);
1339: cnt = 0;
1340: for (xj=0; xj<NHeV[1]; xj++) {
1341: for (xi=xs; xi<xs+xm; xi++) {
1342: idx[cnt++] = NHe + NV + NI + DOF*xi + xj;
1343: }
1344: }
1345: ISCreateGeneral(PetscObjectComm((PetscObject)ts),NHeV[1]*xm,idx,PETSC_OWN_POINTER,&is);
1346: TSGetSolution(ts,&C);
1347: VecScatterCreate(C,is,ctx->HeV,NULL,&ctx->HeVscatter);
1348: ISDestroy(&is);
1349: /* sets the bounds on the contour plot values so the colors mean the same thing for different timesteps */
1350: PetscViewerDrawSetBounds(ctx->HeVviewer,2,valuebounds);
1352: TSMonitorSet(ts,MyMonitorMonitor,ctx,MyMonitorDestroy);
1353: return(0);
1354: }
1358: PetscErrorCode MyLoadData(MPI_Comm comm,const char *filename)
1359: {
1361: FILE *fp;
1362: char buff[256];
1363: PetscInt He,V,I,lc = 0;
1364: char Hebindstr[32],Vbindstr[32],Ibindstr[32],trapbindstr[32],*sharp;
1365: PetscReal Hebind,Vbind,Ibind,trapbind;
1368: PetscFOpen(comm,filename,"r",&fp);
1369: PetscSynchronizedFGets(comm,fp,256,buff);
1370: while (buff[0]) {
1371: PetscStrchr(buff,'#',&sharp);
1372: if (!sharp) {
1373: sscanf(buff,"%d %d %d %s %s %s %s",&He,&V,&I,Hebindstr,Vbindstr,Ibindstr,trapbindstr);
1374: Hebind = strtod(Hebindstr,NULL);
1375: Vbind = strtod(Vbindstr,NULL);
1376: Ibind = strtod(Ibindstr,NULL);
1377: trapbind = strtod(trapbindstr,NULL);
1378: if (V <= NV) {
1379: if (He > NHe && V == 0 && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d %d",He,NHe);
1380: if (He == 0 && V > NV && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct V %d %d",V,NV);
1381: if (He == 0 && V == 0 && I > NI) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NI %d %d",I,NI);
1382: if (lc++ > DOF) SETERRQ4(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d NV %d NI %d MNHeV %",NHe,NV,NI,MNHeV);
1383: if (He > 0 && V > 0) { /* assumes the He are sorted in increasing order */
1384: NHeV[V] = He;
1385: }
1386: }
1387: }
1388: PetscSynchronizedFGets(comm,fp,256,buff);
1389: }
1390: 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);
1391: return(0);
1392: }