Actual source code: ex10.c

petsc-dev 2014-02-02
Report Typos and Errors
  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: }