Actual source code: ex10.c

petsc-3.8.3 2017-12-09
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: */
 20: #define PETSC_SKIP_COMPLEX 1

 22: #include <petscdm.h>
 23: #include <petscdmda.h>
 24: #include <petscts.h>

 26: /*    Hard wire the number of cluster sizes for He, V, and I, and He-V */
 27: #define  NHe          9
 28: #define  NV           10   /* 50 */
 29: #define  NI           2
 30: #define  MHeV         10  /* 50 */  /* maximum V size in He-V */
 31: PetscInt NHeV[MHeV+1];     /* maximum He size in an He-V with given V */
 32: #define  MNHeV        451  /* 6778 */
 33: #define  DOF          (NHe + NV + NI + MNHeV)

 35: /*
 36:      Define all the concentrations (there is one of these structs at each grid point)

 38:       He[He] represents the clusters of pure Helium of size He
 39:       V[V] the Vacencies of size V,
 40:       I[I] represents the clusters of Interstials of size I,  and
 41:       HeV[He][V]  the mixed Helium-Vacancy clusters of size He and V

 43:       The variables He, V, I are always used to index into the concentrations of He, V, and I respectively
 44:       Note that unlike in traditional C code the indices for He[], V[] and I[] run from 1 to N, NOT 0 to N-1

 46: */
 47: typedef struct {
 48:   PetscScalar He[NHe];
 49:   PetscScalar V[NV];
 50:   PetscScalar I[NI];
 51:   PetscScalar HeV[MNHeV];
 52: } Concentrations;



 56: /*
 57:      Holds problem specific options and data
 58: */
 59: typedef struct {
 60:   PetscScalar HeDiffusion[6];
 61:   PetscScalar VDiffusion[2];
 62:   PetscScalar IDiffusion[2];
 63:   PetscScalar forcingScale;
 64:   PetscScalar reactionScale;
 65:   PetscScalar dissociationScale;
 66: } AppCtx;

 68: extern PetscErrorCode RHSFunction(TS,PetscReal,Vec,Vec,void*);
 69: extern PetscErrorCode RHSJacobian(TS,PetscReal,Vec,Mat,Mat,void*);
 70: extern PetscErrorCode InitialConditions(DM,Vec);
 71: extern PetscErrorCode GetDfill(PetscInt*,void*);
 72: extern PetscErrorCode MyLoadData(MPI_Comm,const char*);

 74: int main(int argc,char **argv)
 75: {
 76:   TS             ts;                  /* nonlinear solver */
 77:   Vec            C;                   /* solution */
 79:   DM             da;                  /* manages the grid data */
 80:   AppCtx         ctx;                 /* holds problem specific paramters */
 81:   PetscInt       He,*ofill,*dfill;
 82:   char           filename[PETSC_MAX_PATH_LEN];
 83:   PetscBool      flg;

 85:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 86:      Initialize program
 87:      - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 88:   PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;

 91:   PetscOptionsGetString(NULL,NULL,"-file",filename,PETSC_MAX_PATH_LEN,&flg);
 92:   if (flg) {
 93:     MyLoadData(PETSC_COMM_WORLD,filename);
 94:   }


 97:   ctx.HeDiffusion[1]    = 1000*2.95e-4; /* From Tibo's notes times 1,000 */
 98:   ctx.HeDiffusion[2]    = 1000*3.24e-4;
 99:   ctx.HeDiffusion[3]    = 1000*2.26e-4;
100:   ctx.HeDiffusion[4]    = 1000*1.68e-4;
101:   ctx.HeDiffusion[5]    = 1000*5.20e-5;
102:   ctx.VDiffusion[1]     = 1000*2.71e-3;
103:   ctx.IDiffusion[1]     = 1000*2.13e-4;
104:   ctx.forcingScale      = 100.;         /* made up numbers */
105:   ctx.reactionScale     = .001;
106:   ctx.dissociationScale = .0001;

108:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109:      Create distributed array (DMDA) to manage parallel grid and vectors
110:   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
111:   DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_MIRROR,1,DOF,0,NULL,&da);
112:   DMSetFromOptions(da);
113:   DMSetUp(da);

115:   /* The only spatial coupling in the Jacobian (diffusion) is for the first 5 He, the first V, and the first I.
116:      The ofill (thought of as a DOF by DOF 2d (row-oriented) array) represents the nonzero coupling between degrees
117:      of freedom at one point with degrees of freedom on the adjacent point to the left or right. A 1 at i,j in the
118:      ofill array indicates that the degree of freedom i at a point is coupled to degree of freedom j at the
119:      adjacent point. In this case ofill has only a few diagonal entries since the only spatial coupling is regular diffusion. */
120:   PetscMalloc1(DOF*DOF,&ofill);
121:   PetscMalloc1(DOF*DOF,&dfill);
122:   PetscMemzero(ofill,DOF*DOF*sizeof(PetscInt));
123:   PetscMemzero(dfill,DOF*DOF*sizeof(PetscInt));

125:   /*
126:     dfil (thought of as a DOF by DOF 2d (row-oriented) array) repesents the nonzero coupling between degrees of
127:    freedom within a single grid point, i.e. the reaction and dissassociation interactions. */
128:   PetscMalloc1(DOF*DOF,&dfill);
129:   PetscMemzero(dfill,DOF*DOF*sizeof(PetscInt));
130:   GetDfill(dfill,&ctx);
131:   DMDASetBlockFills(da,dfill,ofill);
132:   PetscFree(ofill);
133:   PetscFree(dfill);

135:   /*  Extract global vector to hold solution */
136:   DMCreateGlobalVector(da,&C);

138:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
139:      Create timestepping solver context
140:      - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
141:   TSCreate(PETSC_COMM_WORLD,&ts);
142:   TSSetType(ts,TSARKIMEX);
143:   TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);
144:   TSSetDM(ts,da);
145:   TSSetProblemType(ts,TS_NONLINEAR);
146:   TSSetRHSFunction(ts,NULL,RHSFunction,&ctx);
147:   TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,&ctx);
148:   TSSetSolution(ts,C);

150:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151:      Set solver options
152:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
153:   TSSetTimeStep(ts,.001);
154:   TSSetMaxSteps(ts,100);
155:   TSSetMaxTime(ts,50.0);
156:   TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
157:   TSSetFromOptions(ts);

159:   InitialConditions(da,C);

161:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162:      Solve the ODE system
163:      - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
164:   TSSolve(ts,C);

166:   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
167:      Free work space.
168:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
169:   VecDestroy(&C);
170:   TSDestroy(&ts);
171:   DMDestroy(&da);
172:   PetscFinalize();
173:   return(0);
174: }

176: /*
177:    cHeV is "trick" to allow easy accessing of the values in the HeV portion of the Concentrations.
178:    cHeV[i] points to the beginning of each row of HeV[] with V indexing starting a 1.

180: */
181: PetscErrorCode cHeVCreate(PetscReal ***cHeV)
182: {

186:   PetscMalloc(MHeV*sizeof(PetscScalar),cHeV);
187:   (*cHeV)--;
188:   return(0);
189: }

191: PetscErrorCode cHeVInitialize(const PetscScalar *start,PetscReal **cHeV)
192: {
193:   PetscInt       i;

196:   cHeV[1] = ((PetscScalar*) start) - 1 + NHe + NV + NI;
197:   for (i=1; i<MHeV; i++) {
198:     cHeV[i+1] = cHeV[i] + NHeV[i];
199:   }
200:   return(0);
201: }

203: PetscErrorCode cHeVDestroy(PetscReal **cHeV)
204: {

208:   cHeV++;
209:   PetscFree(cHeV);
210:   return(0);
211: }

213: /* ------------------------------------------------------------------- */
214: PetscErrorCode InitialConditions(DM da,Vec C)
215: {
217:   PetscInt       i,I,He,V,xs,xm,Mx,cnt = 0;
218:   Concentrations *c;
219:   PetscReal      hx,x,**cHeV;
220:   char           string[16];

223:   DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
224:   hx   = 1.0/(PetscReal)(Mx-1);

226:   /* Name each of the concentrations */
227:   for (He=1; He<NHe+1; He++) {
228:     PetscSNPrintf(string,16,"%d-He",He);
229:     DMDASetFieldName(da,cnt++,string);
230:   }
231:   for (V=1; V<NV+1; V++) {
232:     PetscSNPrintf(string,16,"%d-V",V);
233:     DMDASetFieldName(da,cnt++,string);
234:   }
235:   for (I=1; I<NI+1; I++) {
236:     PetscSNPrintf(string,16,"%d-I",I);
237:     DMDASetFieldName(da,cnt++,string);
238:   }
239:   for (He=1; He<MHeV+1; He++) {
240:     for (V=1; V<NHeV[He]+1; V++) {
241:       PetscSNPrintf(string,16,"%d-He-%d-V",He,V);
242:       DMDASetFieldName(da,cnt++,string);
243:     }
244:   }

246:   /*
247:      Get pointer to vector data
248:   */
249:   DMDAVecGetArrayRead(da,C,&c);
250:   /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
251:   c = (Concentrations*)(((PetscScalar*)c)-1);

253:   /*
254:      Get local grid boundaries
255:   */
256:   DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);

258:   /*
259:      Compute function over the locally owned part of the grid
260:   */
261:   cHeVCreate(&cHeV);
262:   for (i=xs; i<xs+xm; i++) {
263:     x = i*hx;
264:     for (He=1; He<NHe+1; He++) c[i].He[He] = 0.0;
265:     for (V=1;  V<NV+1;   V++)  c[i].V[V]   = 1.0;
266:     for (I=1; I <NI+1;   I++)  c[i].I[I]   = 1.0;
267:     cHeVInitialize(&c[i].He[1],cHeV);
268:     for (V=1; V<MHeV+1; V++) {
269:       for (He=1; He<NHeV[V]+1; He++)  cHeV[V][He] = 0.0;
270:     }
271:   }
272:   cHeVDestroy(cHeV);

274:   /*
275:      Restore vectors
276:   */
277:   c    = (Concentrations*)(((PetscScalar*)c)+1);
278:   DMDAVecRestoreArrayRead(da,C,&c);
279:   return(0);
280: }

282: /* ------------------------------------------------------------------- */
283: /*
284:    RHSFunction - Evaluates nonlinear function that defines the ODE

286:    Input Parameters:
287: .  ts - the TS context
288: .  U - input vector
289: .  ptr - optional user-defined context

291:    Output Parameter:
292: .  F - function values
293:  */
294: PetscErrorCode RHSFunction(TS ts,PetscReal ftime,Vec C,Vec F,void *ptr)
295: {
296:   AppCtx         *ctx = (AppCtx*) ptr;
297:   DM             da;
299:   PetscInt       xi,Mx,xs,xm,He,he,V,v,I,i;
300:   PetscReal      hx,sx,x,**cHeV,**fHeV;
301:   Concentrations *c,*f;
302:   Vec            localC;

305:   TSGetDM(ts,&da);
306:   DMGetLocalVector(da,&localC);
307:   DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
308:   hx   = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
309:   cHeVCreate(&cHeV);
310:   cHeVCreate(&fHeV);

312:   /*
313:      Scatter ghost points to local vector,using the 2-step process
314:         DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
315:      By placing code between these two statements, computations can be
316:      done while messages are in transition.
317:   */
318:   DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
319:   DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);

321:   VecSet(F,0.0);

323:   /*
324:     Get pointers to vector data
325:   */
326:   DMDAVecGetArrayRead(da,localC,&c);
327:   /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
328:   c    = (Concentrations*)(((PetscScalar*)c)-1);
329:   DMDAVecGetArray(da,F,&f);
330:   f    = (Concentrations*)(((PetscScalar*)f)-1);

332:   /*
333:      Get local grid boundaries
334:   */
335:   DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);

337:   /*
338:      Loop over grid points computing ODE terms for each grid point
339:   */
340:   for (xi=xs; xi<xs+xm; xi++) {
341:     x = xi*hx;

343:     /* -------------------------------------------------------------
344:      ---- Compute diffusion over the locally owned part of the grid
345:     */
346:     /* He clusters larger than 5 do not diffuse -- are immobile */
347:     for (He=1; He<PetscMin(NHe+1,6); He++) {
348:       f[xi].He[He] +=  ctx->HeDiffusion[He]*(-2.0*c[xi].He[He] + c[xi-1].He[He] + c[xi+1].He[He])*sx;
349:     }

351:     /* V and I clusters ONLY of size 1 diffuse */
352:     f[xi].V[1] +=  ctx->VDiffusion[1]*(-2.0*c[xi].V[1] + c[xi-1].V[1] + c[xi+1].V[1])*sx;
353:     f[xi].I[1] +=  ctx->IDiffusion[1]*(-2.0*c[xi].I[1] + c[xi-1].I[1] + c[xi+1].I[1])*sx;

355:     /* Mixed He - V clusters are immobile  */

357:     /* ----------------------------------------------------------------
358:      ---- Compute forcing that produces He of cluster size 1
359:           Crude cubic approximation of graph from Tibo's notes
360:     */
361:     f[xi].He[1] +=  ctx->forcingScale*PetscMax(0.0,0.0006*x*x*x  - 0.0087*x*x + 0.0300*x);

363:     cHeVInitialize(&c[xi].He[1],cHeV);
364:     cHeVInitialize(&f[xi].He[1],fHeV);

366:     /* -------------------------------------------------------------------------
367:      ---- Compute dissociation terms that removes an item from a cluster
368:           I assume dissociation means losing only a single item from a cluster
369:           I cannot tell from the notes if clusters can break up into any sub-size.
370:     */
371:     /*   He[He] ->  He[He-1] + He[1] */
372:     for (He=2; He<NHe+1; He++) {
373:       f[xi].He[He-1] += ctx->dissociationScale*c[xi].He[He];
374:       f[xi].He[1]    += ctx->dissociationScale*c[xi].He[He];
375:       f[xi].He[He]   -= ctx->dissociationScale*c[xi].He[He];
376:     }

378:     /*   V[V] ->  V[V-1] + V[1] */
379:     for (V=2; V<NV+1; V++) {
380:       f[xi].V[V-1] += ctx->dissociationScale*c[xi].V[V];
381:       f[xi].V[1]   += ctx->dissociationScale*c[xi].V[V];
382:       f[xi].V[V]   -= ctx->dissociationScale*c[xi].V[V];
383:     }

385:     /*   I[I] ->  I[I-1] + I[1] */
386:     for (I=2; I<NI+1; I++) {
387:       f[xi].I[I-1] += ctx->dissociationScale*c[xi].I[I];
388:       f[xi].I[1]   += ctx->dissociationScale*c[xi].I[I];
389:       f[xi].I[I]   -= ctx->dissociationScale*c[xi].I[I];
390:     }

392:     /*   He[He]-V[1] ->  He[He] + V[1]  */
393:     for (He=1; He<NHeV[1]+1; He++) {
394:       f[xi].He[He] += 1000*ctx->dissociationScale*cHeV[1][He];
395:       f[xi].V[1]   += 1000*ctx->dissociationScale*cHeV[1][He];
396:       fHeV[1][He]  -= 1000*ctx->dissociationScale*cHeV[1][He];
397:     }

399:     /*   He[1]-V[V] ->  He[1] + V[V]  */
400:     for (V=2; V<MHeV+1; V++) {
401:       f[xi].He[1]  += 1000*ctx->dissociationScale*cHeV[V][1];
402:       f[xi].V[V]   += 1000*ctx->dissociationScale*cHeV[V][1];
403:       fHeV[V][1]   -= 1000*ctx->dissociationScale*cHeV[V][1];
404:     }

406:     /*   He[He]-V[V] ->  He[He-1]-V[V] + He[1]  */
407:     for (V=2; V<MHeV+1; V++) {
408:       for (He=2; He<NHeV[V]+1; He++) {
409:         f[xi].He[1]   += 1000*ctx->dissociationScale*cHeV[V][He];
410:         fHeV[V][He-1] += 1000*ctx->dissociationScale*cHeV[V][He];
411:         fHeV[V][He]   -= 1000*ctx->dissociationScale*cHeV[V][He];
412:       }
413:     }

415:     /*   He[He]-V[V] ->  He[He]-V[V-1] + V[1]  */
416:     for (V=2; V<MHeV+1; V++) {
417:       for (He=2; He<NHeV[V-1]+1; He++) {
418:         f[xi].V[1]    += 1000*ctx->dissociationScale*cHeV[V][He];
419:         fHeV[V-1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
420:         fHeV[V][He]   -= 1000*ctx->dissociationScale*cHeV[V][He];
421:       }
422:     }

424:     /*   He[He]-V[V] ->  He[He]-V[V+1] + I[1]  */
425:     for (V=1; V<MHeV; V++) {
426:       for (He=1; He<NHeV[V]+1; He++) {
427:         fHeV[V+1][He] += 1000*ctx->dissociationScale*cHeV[V][He];
428:         f[xi].I[1]    += 1000*ctx->dissociationScale*cHeV[V][He];
429:         fHeV[V][He]   -= 1000*ctx->dissociationScale*cHeV[V][He];
430:       }
431:     }

433:     /* ----------------------------------------------------------------
434:      ---- Compute reaction terms that can create a cluster of given size
435:     */
436:     /*   He[He] + He[he] -> He[He+he]  */
437:     for (He=2; He<NHe+1; He++) {
438:       /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
439:          remove the upper half since they are symmetric to the lower half of the pairs. For example
440:               when He = 5 (cluster size 5) the pairs are
441:                  1   4
442:                  2   2
443:                  3   2  these last two are not needed in the sum since they repeat from above
444:                  4   1  this is why he < (He/2) + 1            */
445:       for (he=1; he<(He/2)+1; he++) {
446:         f[xi].He[He] += ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];

448:         /* remove the two clusters that merged to form the larger cluster */
449:         f[xi].He[he]    -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
450:         f[xi].He[He-he] -= ctx->reactionScale*c[xi].He[he]*c[xi].He[He-he];
451:       }
452:     }

454:     /*   V[V]  +  V[v] ->  V[V+v]  */
455:     for (V=2; V<NV+1; V++) {
456:       for (v=1; v<(V/2)+1; v++) {
457:         f[xi].V[V]   += ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
458:         f[xi].V[v]   -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
459:         f[xi].V[V-v] -= ctx->reactionScale*c[xi].V[v]*c[xi].V[V-v];
460:       }
461:     }

463:     /*   I[I] +  I[i] -> I[I+i] */
464:     for (I=2; I<NI+1; I++) {
465:       for (i=1; i<(I/2)+1; i++) {
466:         f[xi].I[I]   += ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
467:         f[xi].I[i]   -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
468:         f[xi].I[I-i] -= ctx->reactionScale*c[xi].I[i]*c[xi].I[I-i];
469:       }
470:     }

472:     /* He[1] +  V[1]  ->  He[1]-V[1] */
473:     fHeV[1][1]  += 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
474:     f[xi].He[1] -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];
475:     f[xi].V[1]  -= 1000*ctx->reactionScale*c[xi].He[1]*c[xi].V[1];

477:     /*  He[He]-V[V] + He[he] -> He[He+he]-V[V]  */
478:     for (V=1; V<MHeV+1; V++) {
479:       for (He=1; He<NHeV[V]; He++) {
480:         for (he=1; he+He<NHeV[V]+1; he++) {
481:           fHeV[V][He+he] += ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
482:           f[xi].He[he]   -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
483:           fHeV[V][He]    -= ctx->reactionScale*cHeV[V][He]*c[xi].He[he];
484:         }
485:       }
486:     }

488:     /*  He[He]-V[V] + V[1] -> He[He][V+1] */
489:     for (V=1; V<MHeV; V++) {
490:       for (He=1; He<NHeV[V+1]; He++) {
491:           fHeV[V+1][He] += ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
492:           /* remove the two clusters that merged to form the larger cluster */
493:           f[xi].V[1]  -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
494:           fHeV[V][He] -= ctx->reactionScale*cHeV[V][He]*c[xi].V[1];
495:       }
496:     }

498:     /*  He[He]-V[V]  + He[he]-V[v] -> He[He+he][V+v]  */
499:     /*  Currently the reaction rates for this are zero */


502:     /*  V[V] + I[I]  ->   V[V-I] if V > I else I[I-V] */
503:     for (V=1; V<NV+1; V++) {
504:       for (I=1; I<PetscMin(V,NI); I++) {
505:         f[xi].V[V-I] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
506:         f[xi].V[V]   -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
507:         f[xi].I[I]   -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
508:       }
509:       for (I=V+1; I<NI+1; I++) {
510:           f[xi].I[I-V] += ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
511:           f[xi].V[V]   -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
512:           f[xi].I[I]   -= ctx->reactionScale*c[xi].V[V]*c[xi].I[I];
513:       }
514:     }
515:   }

517:   /*
518:      Restore vectors
519:   */
520:   c    = (Concentrations*)(((PetscScalar*)c)+1);
521:   DMDAVecRestoreArray(da,localC,&c);
522:   f    = (Concentrations*)(((PetscScalar*)f)+1);
523:   DMDAVecRestoreArray(da,F,&f);
524:   DMRestoreLocalVector(da,&localC);
525:   cHeVDestroy(cHeV);
526:   cHeVDestroy(fHeV);
527:   return(0);
528: }

530: /*
531:     Compute the Jacobian entries based on IFuction() and insert them into the matrix
532: */
533: PetscErrorCode RHSJacobian(TS ts,PetscReal ftime,Vec C,Mat A,Mat J,void *ptr)
534: {
535:   AppCtx               *ctx = (AppCtx*) ptr;
536:   DM                   da;
537:   PetscErrorCode       ierr;
538:   PetscInt             xi,Mx,xs,xm,He,he,V,v,I,i;
539:   PetscInt             row[3],col[3];
540:   PetscReal            hx,sx,x,val[6];
541:   const Concentrations *c,*f;
542:   Vec                  localC;
543:   const PetscReal      *rowstart,*colstart;
544:   const PetscReal      **cHeV,**fHeV;
545:   static PetscBool     initialized = PETSC_FALSE;

548:   cHeVCreate((PetscScalar***)&cHeV);
549:   cHeVCreate((PetscScalar***)&fHeV);
550:   MatZeroEntries(J);
551:   TSGetDM(ts,&da);
552:   DMGetLocalVector(da,&localC);
553:   DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
554:   hx   = 8.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);

556:   DMGlobalToLocalBegin(da,C,INSERT_VALUES,localC);
557:   DMGlobalToLocalEnd(da,C,INSERT_VALUES,localC);

559:   /*
560:     The f[] is dummy, values are never set into it. It is only used to determine the
561:     local row for the entries in the Jacobian
562:   */
563:   DMDAVecGetArray(da,localC,&c);
564:   /* Shift the c pointer to allow accessing with index of 1, instead of 0 */
565:   c    = (Concentrations*)(((PetscScalar*)c)-1);
566:   DMDAVecGetArray(da,C,&f);
567:   f    = (Concentrations*)(((PetscScalar*)f)-1);

569:   DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);

571:   rowstart = &f[xs].He[1] -  DOF;
572:   colstart = &c[xs-1].He[1];

574:   if (!initialized) {
575:     /*
576:      Loop over grid points computing Jacobian terms for each grid point
577:      */
578:     for (xi=xs; xi<xs+xm; xi++) {
579:       x = xi*hx;
580: 
581:       cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
582:       cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
583: 
584:       /* -------------------------------------------------------------
585:        ---- Compute diffusion over the locally owned part of the grid
586:        */
587:     /* He clusters larger than 5 do not diffuse -- are immobile */
588:       for (He=1; He<PetscMin(NHe+1,6); He++) {
589:         row[0] = &f[xi].He[He] - rowstart;
590:         col[0] = &c[xi-1].He[He] - colstart;
591:         col[1] = &c[xi].He[He] - colstart;
592:         col[2] = &c[xi+1].He[He] - colstart;
593:         val[0] = ctx->HeDiffusion[He]*sx;
594:         val[1] = -2.0*ctx->HeDiffusion[He]*sx;
595:         val[2] = ctx->HeDiffusion[He]*sx;
596:         MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
597:       }

599:       /* V and I clusters ONLY of size 1 diffuse */
600:       row[0] = &f[xi].V[1] - rowstart;
601:       col[0] = &c[xi-1].V[1] - colstart;
602:       col[1] = &c[xi].V[1] - colstart;
603:       col[2] = &c[xi+1].V[1] - colstart;
604:       val[0] = ctx->VDiffusion[1]*sx;
605:       val[1] = -2.0*ctx->VDiffusion[1]*sx;
606:       val[2] = ctx->VDiffusion[1]*sx;
607:       MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
608: 
609:       row[0] = &f[xi].I[1] - rowstart;
610:       col[0] = &c[xi-1].I[1] - colstart;
611:       col[1] = &c[xi].I[1] - colstart;
612:       col[2] = &c[xi+1].I[1] - colstart;
613:       val[0] = ctx->IDiffusion[1]*sx;
614:       val[1] = -2.0*ctx->IDiffusion[1]*sx;
615:       val[2] = ctx->IDiffusion[1]*sx;
616:       MatSetValuesLocal(J,1,row,3,col,val,ADD_VALUES);
617: 
618:       /* Mixed He - V clusters are immobile  */
619: 
620:       /* -------------------------------------------------------------------------
621:        ---- Compute dissociation terms that removes an item from a cluster
622:        I assume dissociation means losing only a single item from a cluster
623:        I cannot tell from the notes if clusters can break up into any sub-size.
624:        */
625: 
626:       /*   He[He] ->  He[He-1] + He[1] */
627:       for (He=2; He<NHe+1; He++) {
628:         row[0] = &f[xi].He[He-1] - rowstart;
629:         row[1] = &f[xi].He[1] - rowstart;
630:         row[2] = &f[xi].He[He] - rowstart;
631:         col[0] = &c[xi].He[He] - colstart;
632:         val[0] = ctx->dissociationScale;
633:         val[1] = ctx->dissociationScale;
634:         val[2] = -ctx->dissociationScale;
635:         MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
636:       }
637: 
638:       /*   V[V] ->  V[V-1] + V[1] */
639:       for (V=2; V<NV+1; V++) {
640:         row[0] = &f[xi].V[V-1] - rowstart;
641:         row[1] = &f[xi].V[1] - rowstart;
642:         row[2] = &f[xi].V[V] - rowstart;
643:         col[0] = &c[xi].V[V] - colstart;
644:         val[0] = ctx->dissociationScale;
645:         val[1] = ctx->dissociationScale;
646:         val[2] = -ctx->dissociationScale;
647:         MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
648:       }
649: 
650:       /*   I[I] ->  I[I-1] + I[1] */
651:       for (I=2; I<NI+1; I++) {
652:         row[0] = &f[xi].I[I-1] - rowstart;
653:         row[1] = &f[xi].I[1] - rowstart;
654:         row[2] = &f[xi].I[I] - rowstart;
655:         col[0] = &c[xi].I[I] - colstart;
656:         val[0] = ctx->dissociationScale;
657:         val[1] = ctx->dissociationScale;
658:         val[2] = -ctx->dissociationScale;
659:         MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
660:       }
661: 
662:       /*   He[He]-V[1] ->  He[He] + V[1]  */
663:       for (He=1; He<NHeV[1]+1; He++) {
664:         row[0] = &f[xi].He[He] - rowstart;
665:         row[1] = &f[xi].V[1] - rowstart;
666:         row[2] = &fHeV[1][He] - rowstart;
667:         col[0] = &cHeV[1][He] - colstart;
668:         val[0] = 1000*ctx->dissociationScale;
669:         val[1] = 1000*ctx->dissociationScale;
670:         val[2] = -1000*ctx->dissociationScale;
671:         MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
672:       }
673: 
674:       /*   He[1]-V[V] ->  He[1] + V[V]  */
675:       for (V=2; V<MHeV+1; V++) {
676:         row[0] = &f[xi].He[1] - rowstart;
677:         row[1] = &f[xi].V[V] - rowstart;
678:         row[2] = &fHeV[V][1] - rowstart;
679:         col[0] = &cHeV[V][1] - colstart;
680:         val[0] = 1000*ctx->dissociationScale;
681:         val[1] = 1000*ctx->dissociationScale;
682:         val[2] = -1000*ctx->dissociationScale;
683:         MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
684:       }
685: 
686:       /*   He[He]-V[V] ->  He[He-1]-V[V] + He[1]  */
687:       for (V=2; V<MHeV+1; V++) {
688:         for (He=2; He<NHeV[V]+1; He++) {
689:           row[0] = &f[xi].He[1] - rowstart;
690:           row[1] = &fHeV[V][He-1] - rowstart;
691:           row[2] = &fHeV[V][He] - rowstart;
692:           col[0] = &cHeV[V][He] - colstart;
693:           val[0] = 1000*ctx->dissociationScale;
694:           val[1] = 1000*ctx->dissociationScale;
695:           val[2] = -1000*ctx->dissociationScale;
696:           MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
697:         }
698:       }
699: 
700:       /*   He[He]-V[V] ->  He[He]-V[V-1] + V[1]  */
701:       for (V=2; V<MHeV+1; V++) {
702:         for (He=2; He<NHeV[V-1]+1; He++) {
703:           row[0] = &f[xi].V[1] - rowstart;
704:           row[1] = &fHeV[V-1][He] - rowstart;
705:           row[2] = &fHeV[V][He] - rowstart;
706:           col[0] = &cHeV[V][He] - colstart;
707:           val[0] = 1000*ctx->dissociationScale;
708:           val[1] = 1000*ctx->dissociationScale;
709:           val[2] = -1000*ctx->dissociationScale;
710:           MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
711:         }
712:       }
713: 
714:       /*   He[He]-V[V] ->  He[He]-V[V+1] + I[1]  */
715:       for (V=1; V<MHeV; V++) {
716:         for (He=1; He<NHeV[V]+1; He++) {
717:           row[0] = &fHeV[V+1][He] - rowstart;
718:           row[1] = &f[xi].I[1] - rowstart;
719:           row[2] = &fHeV[V][He] - rowstart;
720:           col[0] = &cHeV[V][He] - colstart;
721:           val[0] = 1000*ctx->dissociationScale;
722:           val[1] = 1000*ctx->dissociationScale;
723:           val[2] = -1000*ctx->dissociationScale;
724:           MatSetValuesLocal(J,3,row,1,col,val,ADD_VALUES);
725:         }
726:       }
727:     }
728:     MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
729:     MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
730:     MatSetOption(J,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);
731:     MatStoreValues(J);
732:     MatSetFromOptions(J);
733:     initialized = PETSC_TRUE;
734:   } else {
735:     MatRetrieveValues(J);
736:   }

738:   /*
739:      Loop over grid points computing Jacobian terms for each grid point for reaction terms
740:   */
741:   for (xi=xs; xi<xs+xm; xi++) {
742:     x = xi*hx;
743:     cHeVInitialize(&c[xi].He[1],(PetscScalar**)cHeV);
744:     cHeVInitialize(&f[xi].He[1],(PetscScalar**)fHeV);
745:     /* ----------------------------------------------------------------
746:      ---- Compute reaction terms that can create a cluster of given size
747:     */
748:     /*   He[He] + He[he] -> He[He+he]  */
749:     for (He=2; He<NHe+1; He++) {
750:       /* compute all pairs of clusters of smaller size that can combine to create a cluster of size He,
751:          remove the upper half since they are symmetric to the lower half of the pairs. For example
752:               when He = 5 (cluster size 5) the pairs are
753:                  1   4
754:                  2   2
755:                  3   2  these last two are not needed in the sum since they repeat from above
756:                  4   1  this is why he < (He/2) + 1            */
757:       for (he=1; he<(He/2)+1; he++) {
758:         row[0] = &f[xi].He[He] - rowstart;
759:         row[1] = &f[xi].He[he] - rowstart;
760:         row[2] = &f[xi].He[He-he] - rowstart;
761:         col[0] = &c[xi].He[he] - colstart;
762:         col[1] = &c[xi].He[He-he] - colstart;
763:         val[0] = ctx->reactionScale*c[xi].He[He-he];
764:         val[1] = ctx->reactionScale*c[xi].He[he];
765:         val[2] = -ctx->reactionScale*c[xi].He[He-he];
766:         val[3] = -ctx->reactionScale*c[xi].He[he];
767:         val[4] = -ctx->reactionScale*c[xi].He[He-he];
768:         val[5] = -ctx->reactionScale*c[xi].He[he];
769:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
770:       }
771:     }

773:     /*   V[V]  +  V[v] ->  V[V+v]  */
774:     for (V=2; V<NV+1; V++) {
775:       for (v=1; v<(V/2)+1; v++) {
776:         row[0] = &f[xi].V[V] - rowstart;
777:         row[1] = &f[xi].V[v] - rowstart;
778:         row[2] = &f[xi].V[V-v] - rowstart;
779:         col[0] = &c[xi].V[v] - colstart;
780:         col[1] = &c[xi].V[V-v] - colstart;
781:         val[0] = ctx->reactionScale*c[xi].V[V-v];
782:         val[1] = ctx->reactionScale*c[xi].V[v];
783:         val[2] = -ctx->reactionScale*c[xi].V[V-v];
784:         val[3] = -ctx->reactionScale*c[xi].V[v];
785:         val[4] = -ctx->reactionScale*c[xi].V[V-v];
786:         val[5] = -ctx->reactionScale*c[xi].V[v];
787:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
788:       }
789:     }

791:     /*   I[I] +  I[i] -> I[I+i] */
792:     for (I=2; I<NI+1; I++) {
793:       for (i=1; i<(I/2)+1; i++) {
794:         row[0] = &f[xi].I[I] - rowstart;
795:         row[1] = &f[xi].I[i] - rowstart;
796:         row[2] = &f[xi].I[I-i] - rowstart;
797:         col[0] = &c[xi].I[i] - colstart;
798:         col[1] = &c[xi].I[I-i] - colstart;
799:         val[0] = ctx->reactionScale*c[xi].I[I-i];
800:         val[1] = ctx->reactionScale*c[xi].I[i];
801:         val[2] = -ctx->reactionScale*c[xi].I[I-i];
802:         val[3] = -ctx->reactionScale*c[xi].I[i];
803:         val[4] = -ctx->reactionScale*c[xi].I[I-i];
804:         val[5] = -ctx->reactionScale*c[xi].I[i];
805:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
806:       }
807:     }

809:     /* He[1] +  V[1]  ->  He[1]-V[1] */
810:     row[0] = &fHeV[1][1] - rowstart;
811:     row[1] = &f[xi].He[1] - rowstart;
812:     row[2] = &f[xi].V[1] - rowstart;
813:     col[0] = &c[xi].He[1] - colstart;
814:     col[1] = &c[xi].V[1] - colstart;
815:     val[0] = 1000*ctx->reactionScale*c[xi].V[1];
816:     val[1] = 1000*ctx->reactionScale*c[xi].He[1];
817:     val[2] = -1000*ctx->reactionScale*c[xi].V[1];
818:     val[3] = -1000*ctx->reactionScale*c[xi].He[1];
819:     val[4] = -1000*ctx->reactionScale*c[xi].V[1];
820:     val[5] = -1000*ctx->reactionScale*c[xi].He[1];
821:     MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);

823:     /*  He[He]-V[V] + He[he] -> He[He+he]-V[V]  */
824:    for (V=1; V<MHeV+1; V++) {
825:       for (He=1; He<NHeV[V]; He++) {
826:          for (he=1; he+He<NHeV[V]+1; he++) {
827:           row[0] = &fHeV[V][He+he] - rowstart;
828:           row[1] = &f[xi].He[he] - rowstart;
829:           row[2] = &fHeV[V][He] - rowstart;
830:           col[0] = &c[xi].He[he] - colstart;
831:           col[1] = &cHeV[V][He] - colstart;
832:           val[0] = ctx->reactionScale*cHeV[V][He];
833:           val[1] = ctx->reactionScale*c[xi].He[he];
834:           val[2] = -ctx->reactionScale*cHeV[V][He];
835:           val[3] = -ctx->reactionScale*c[xi].He[he];
836:           val[4] = -ctx->reactionScale*cHeV[V][He];
837:           val[5] = -ctx->reactionScale*c[xi].He[he];
838:           MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
839:         }
840:       }
841:     }

843:     /*  He[He]-V[V] + V[1] -> He[He][V+1] */
844:     for (V=1; V<MHeV; V++) {
845:       for (He=1; He<NHeV[V+1]; He++) {
846:         row[0] = &fHeV[V+1][He] - rowstart;
847:         row[1] = &f[xi].V[1] - rowstart;
848:         row[2] = &fHeV[V][He] - rowstart;
849:         col[0] = &c[xi].V[1] - colstart;
850:         col[1] = &cHeV[V][He] - colstart;
851:         val[0] = ctx->reactionScale*cHeV[V][He];
852:         val[1] = ctx->reactionScale*c[xi].V[1];
853:         val[2] = -ctx->reactionScale*cHeV[V][He];
854:         val[3] = -ctx->reactionScale*c[xi].V[1];
855:         val[4] = -ctx->reactionScale*cHeV[V][He];
856:         val[5] = -ctx->reactionScale*c[xi].V[1];
857:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
858:      }
859:     }

861:     /*  He[He]-V[V]  + He[he]-V[v] -> He[He+he][V+v]  */
862:     /*  Currently the reaction rates for this are zero */


865:     /*  V[V] + I[I]  ->   V[V-I] if V > I else I[I-V] */
866:     for (V=1; V<NV+1; V++) {
867:       for (I=1; I<PetscMin(V,NI); I++) {
868:         row[0] = &f[xi].V[V-I] - rowstart;
869:         row[1] = &f[xi].V[V] - rowstart;
870:         row[2] = &f[xi].I[I] - rowstart;
871:         col[0] = &c[xi].V[V] - colstart;
872:         col[1] = &c[xi].I[I]  - colstart;
873:         val[0] = ctx->reactionScale*c[xi].I[I];
874:         val[1] = ctx->reactionScale*c[xi].V[V];
875:         val[2] = -ctx->reactionScale*c[xi].I[I];
876:         val[3] = -ctx->reactionScale*c[xi].V[V];
877:         val[4] = -ctx->reactionScale*c[xi].I[I];
878:         val[5] = -ctx->reactionScale*c[xi].V[V];
879:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
880:       }
881:       for (I=V+1; I<NI+1; I++) {
882:         row[0] = &f[xi].I[I-V] - rowstart;
883:         row[1] = &f[xi].V[V] - rowstart;
884:         row[2] = &f[xi].I[I] - rowstart;
885:         col[0] = &c[xi].V[V] - colstart;
886:         col[1] = &c[xi].I[I] - colstart;
887:         val[0] = ctx->reactionScale*c[xi].I[I];
888:         val[1] = ctx->reactionScale*c[xi].V[V];
889:         val[2] = -ctx->reactionScale*c[xi].I[I];
890:         val[3] = -ctx->reactionScale*c[xi].V[V];
891:         val[4] = -ctx->reactionScale*c[xi].I[I];
892:         val[5] = -ctx->reactionScale*c[xi].V[V];
893:         MatSetValuesLocal(J,3,row,2,col,val,ADD_VALUES);
894:       }
895:     }
896:   }

898:   /*
899:      Restore vectors
900:   */
901:   c    = (Concentrations*)(((PetscScalar*)c)+1);
902:   DMDAVecRestoreArray(da,localC,&c);
903:   f    = (Concentrations*)(((PetscScalar*)f)+1);
904:   DMDAVecRestoreArray(da,C,&f);
905:   DMRestoreLocalVector(da,&localC);
906:   cHeVDestroy((PetscScalar**)cHeV);
907:   cHeVDestroy((PetscScalar**)fHeV);

909:   MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
910:   MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
911:   if (A != J) {
912:     MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
913:     MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
914:   }
915:   return(0);
916: }

918: /*
919:     Determines the nonzero structure within the diagonal blocks of the Jacobian that represent coupling resulting from reactions and
920:     dissasociations of the clusters
921: */
922: PetscErrorCode GetDfill(PetscInt *dfill, void *ptr)
923: {
924:   PetscInt       He,he,V,v,I,i,j,k,rows[3],cols[2];
925:   Concentrations *c;
926:   PetscScalar    *idxstart,**cHeV;

929:   /* ensure fill for the diagonal of matrix */
930:   for (i=0; i<(DOF); i++) {
931:     dfill[i*DOF + i] = 1;
932:   }

934:   /*
935:    c is never used except for computing offsets between variables which are used to fill the non-zero
936:    structure of the matrix
937:    */
938:   PetscNew(&c);
939:   c        = (Concentrations*)(((PetscScalar*)c)-1);
940:   cHeVCreate(&cHeV);
941:   cHeVInitialize(&c->He[1],cHeV);
942:   idxstart = (PetscScalar*)&c->He[1];

944:   /* -------------------------------------------------------------------------
945:    ---- Compute dissociation terms that removes an item from a cluster
946:    I assume dissociation means losing only a single item from a cluster
947:    I cannot tell from the notes if clusters can break up into any sub-size.
948:    */
949:   /*   He[He] ->  He[He-1] + He[1] */
950:   for (He=2; He<NHe+1; He++) {
951:     rows[0] = &c->He[He-1] - idxstart;
952:     rows[1] = &c->He[1] - idxstart;
953:     rows[2] = &c->He[He] - idxstart;
954:     cols[0] = &c->He[He] - idxstart;
955:     for (j=0; j<3; j++) {
956:       dfill[rows[j]*DOF + cols[0]] = 1;
957:     }
958:   }

960:   /*   V[V] ->  V[V-1] + V[1] */
961:   for (V=2; V<NV+1; V++) {
962:     rows[0] = &c->V[V] - idxstart;
963:     rows[1] = &c->V[1] - idxstart;
964:     rows[2] = &c->V[V-1] - idxstart;
965:     cols[0] = &c->V[V] - idxstart;
966:     for (j=0; j<3; j++) {
967:       dfill[rows[j]*DOF + cols[0]] = 1;
968:     }
969:   }
970: 
971:   /*   I[I] ->  I[I-1] + I[1] */
972:   for (I=2; I<NI+1; I++) {
973:     rows[0] = &c->I[I] - idxstart;
974:     rows[1] = &c->I[1] - idxstart;
975:     rows[2] = &c->I[I-1] - idxstart;
976:     cols[0] = &c->I[I] - idxstart;
977:     for (j=0; j<3; j++) {
978:       dfill[rows[j]*DOF + cols[0]] = 1;
979:     }
980:   }
981: 
982:   /*   He[He]-V[1] ->  He[He] + V[1]  */
983:   for (He=1; He<NHeV[1]+1; He++) {
984:     rows[0] = &c->He[He] - idxstart;
985:     rows[1] = &c->V[1] - idxstart;
986:     rows[2] = &cHeV[1][He] - idxstart;
987:     cols[0] = &cHeV[1][He] - idxstart;
988:     for (j=0; j<3; j++) {
989:       dfill[rows[j]*DOF + cols[0]] = 1;
990:     }
991:   }
992: 
993:   /*   He[1]-V[V] ->  He[1] + V[V]  */
994:   for (V=2; V<MHeV+1; V++) {
995:     rows[0] = &c->He[1] - idxstart;
996:     rows[1] = &c->V[V] - idxstart;
997:     rows[2] = &cHeV[V][1] - idxstart;
998:     cols[0] = &cHeV[V][1] - idxstart;
999:     for (j=0; j<3; j++) {
1000:       dfill[rows[j]*DOF + cols[0]] = 1;
1001:     }
1002:   }
1003: 
1004:   /*   He[He]-V[V] ->  He[He-1]-V[V] + He[1]  */
1005:   for (V=2; V<MHeV+1; V++) {
1006:     for (He=2; He<NHeV[V]+1; He++) {
1007:       rows[0] = &c->He[1] - idxstart;
1008:       rows[1] = &cHeV[V][He] - idxstart;
1009:       rows[2] = &cHeV[V][He-1] - idxstart;
1010:       cols[0] = &cHeV[V][He] - idxstart;
1011:       for (j=0; j<3; j++) {
1012:         dfill[rows[j]*DOF + cols[0]] = 1;
1013:       }
1014:     }
1015:   }
1016: 
1017:   /*   He[He]-V[V] ->  He[He]-V[V-1] + V[1]  */
1018:   for (V=2; V<MHeV+1; V++) {
1019:     for (He=2; He<NHeV[V-1]+1; He++) {
1020:       rows[0] = &c->V[1] - idxstart;
1021:       rows[1] = &cHeV[V][He] - idxstart;
1022:       rows[2] = &cHeV[V-1][He] - idxstart;
1023:       cols[0] = &cHeV[V][He] - idxstart;
1024:       for (j=0; j<3; j++) {
1025:         dfill[rows[j]*DOF + cols[0]] = 1;
1026:       }
1027:     }
1028:   }
1029: 
1030:   /*   He[He]-V[V] ->  He[He]-V[V+1] + I[1]  */
1031:   for (V=1; V<MHeV; V++) {
1032:     for (He=1; He<NHeV[V]+1; He++) {
1033:       rows[0] = &c->I[1] - idxstart;
1034:       rows[1] = &cHeV[V+1][He] - idxstart;
1035:       rows[2] = &cHeV[V][He] - idxstart;
1036:       cols[0] = &cHeV[V][He] - idxstart;
1037:       for (j=0; j<3; j++) {
1038:         dfill[rows[j]*DOF + cols[0]] = 1;
1039:       }
1040:     }
1041:   }

1043:   /* These are the reaction terms in the diagonal block */
1044:   for (He=2; He<NHe+1; He++) {
1045:     for (he=1; he<(He/2)+1; he++) {
1046:       rows[0] = &c->He[He] - idxstart;
1047:       rows[1] = &c->He[he] - idxstart;
1048:       rows[2] = &c->He[He-he] - idxstart;
1049:       cols[0] = &c->He[he] - idxstart;
1050:       cols[1] = &c->He[He-he] - idxstart;
1051:       for (j=0; j<3; j++) {
1052:         for (k=0; k<2; k++) {
1053:           dfill[rows[j]*DOF + cols[k]] = 1;
1054:         }
1055:       }
1056:     }
1057:   }

1059:   /*   V[V]  +  V[v] ->  V[V+v]  */
1060:   for (V=2; V<NV+1; V++) {
1061:     for (v=1; v<(V/2)+1; v++) {
1062:       rows[0] = &c->V[V] - idxstart;
1063:       rows[1] = &c->V[v] - idxstart;
1064:       rows[2] = &c->V[V-v] - idxstart;
1065:       cols[0] = &c->V[v] - idxstart;
1066:       cols[1] = &c->V[V-v] - idxstart;
1067:       for (j=0; j<3; j++) {
1068:         for (k=0; k<2; k++) {
1069:           dfill[rows[j]*DOF + cols[k]] = 1;
1070:         }
1071:       }
1072:     }
1073:   }
1074: 
1075:   /*   I[I] +  I[i] -> I[I+i] */
1076:   for (I=2; I<NI+1; I++) {
1077:     for (i=1; i<(I/2)+1; i++) {
1078:       rows[0] = &c->I[I] - idxstart;
1079:       rows[1] = &c->I[i] - idxstart;
1080:       rows[2] = &c->I[I-i] - idxstart;
1081:       cols[0] = &c->I[i] - idxstart;
1082:       cols[1] = &c->I[I-i] - idxstart;
1083:       for (j=0; j<3; j++) {
1084:         for (k=0; k<2; k++) {
1085:           dfill[rows[j]*DOF + cols[k]] = 1;
1086:         }
1087:       }
1088:     }
1089:   }
1090: 
1091:   /* He[1] +  V[1]  ->  He[1]-V[1] */
1092:   rows[0] = &cHeV[1][1] - idxstart;
1093:   rows[1] = &c->He[1] - idxstart;
1094:   rows[2] = &c->V[1] - idxstart;
1095:   cols[0] = &c->He[1] - idxstart;
1096:   cols[1] = &c->V[1] - idxstart;
1097:   for (j=0; j<3; j++) {
1098:     for (k=0; k<2; k++) {
1099:       dfill[rows[j]*DOF + cols[k]] = 1;
1100:     }
1101:   }
1102: 
1103:   /*  He[He]-V[V] + He[he] -> He[He+he]-V[V]  */
1104:   for (V=1; V<MHeV+1; V++) {
1105:     for (He=1; He<NHeV[V]; He++) {
1106:       for (he=1; he+He<NHeV[V]+1; he++) {
1107:         rows[0] = &cHeV[V][He+he] - idxstart;
1108:         rows[1] = &c->He[he] - idxstart;
1109:         rows[2] = &cHeV[V][He] - idxstart;
1110:         cols[0] = &cHeV[V][He] - idxstart;
1111:         cols[1] = &c->He[he] - idxstart;
1112:         for (j=0; j<3; j++) {
1113:           for (k=0; k<2; k++) {
1114:             dfill[rows[j]*DOF + cols[k]] = 1;
1115:           }
1116:         }
1117:       }
1118:     }
1119:   }
1120:   /*  He[He]-V[V] + V[1] -> He[He][V+1] */
1121:   for (V=1; V<MHeV; V++) {
1122:     for (He=1; He<NHeV[V+1]; He++) {
1123:       rows[0] = &cHeV[V+1][He] - idxstart;
1124:       rows[1] = &c->V[1] - idxstart;
1125:       rows[2] = &cHeV[V][He] - idxstart;
1126:       cols[0] = &cHeV[V][He] - idxstart;
1127:       cols[1] = &c->V[1] - idxstart;
1128:       for (j=0; j<3; j++) {
1129:         for (k=0; k<2; k++) {
1130:           dfill[rows[j]*DOF + cols[k]] = 1;
1131:         }
1132:       }
1133:     }
1134:   }

1136:   /*  He[He]-V[V]  + He[he]-V[v] -> He[He+he][V+v]  */
1137:   /*  Currently the reaction rates for this are zero */
1138: 
1139:   /*  V[V] + I[I]  ->   V[V-I] if V > I else I[I-V] */
1140:   for (V=1; V<NV+1; V++) {
1141:     for (I=1; I<PetscMin(V,NI); I++) {
1142:       rows[0] = &c->V[V-I] - idxstart;
1143:       rows[1] = &c->V[V] - idxstart;
1144:       rows[2] = &c->I[I] - idxstart;
1145:       cols[0] = &c->V[V] - idxstart;
1146:       cols[1] = &c->I[I] - idxstart;
1147:       for (j=0; j<3; j++) {
1148:         for (k=0; k<2; k++) {
1149:           dfill[rows[j]*DOF + cols[k]] = 1;
1150:         }
1151:       }
1152:     }
1153:     for (I=V+1; I<NI+1; I++) {
1154:       rows[0] = &c->I[I-V] - idxstart;
1155:       rows[1] = &c->V[V] - idxstart;
1156:       rows[2] = &c->I[I] - idxstart;
1157:       cols[0] = &c->V[V] - idxstart;
1158:       cols[1] = &c->I[I] - idxstart;
1159:       for (j=0; j<3; j++) {
1160:         for (k=0; k<2; k++) {
1161:           dfill[rows[j]*DOF + cols[k]] = 1;
1162:         }
1163:       }
1164:     }
1165:   }

1167:   c    = (Concentrations*)(((PetscScalar*)c)+1);
1168:   cHeVDestroy(cHeV);
1169:   PetscFree(c);
1170:   return(0);
1171: }
1172: /* ------------------------------------------------------------------- */


1175: PetscErrorCode MyLoadData(MPI_Comm comm,const char *filename)
1176: {
1178:   FILE           *fp;
1179:   char           buff[256];
1180:   PetscInt       He,V,I,lc = 0;
1181:   char           Hebindstr[32],Vbindstr[32],Ibindstr[32],trapbindstr[32],*sharp;
1182:   PetscReal      Hebind,Vbind,Ibind,trapbind;

1185:   PetscFOpen(comm,filename,"r",&fp);
1186:   PetscSynchronizedFGets(comm,fp,256,buff);
1187:   while (buff[0]) {
1188:     PetscStrchr(buff,'#',&sharp);
1189:     if (!sharp) {
1190:       sscanf(buff,"%d %d %d %s %s %s %s",&He,&V,&I,Hebindstr,Vbindstr,Ibindstr,trapbindstr);
1191:       Hebind = strtod(Hebindstr,NULL);
1192:       Vbind = strtod(Vbindstr,NULL);
1193:       Ibind = strtod(Ibindstr,NULL);
1194:       trapbind = strtod(trapbindstr,NULL);
1195:       if (V <= NV) {
1196:         if (He > NHe && V == 0 && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d %d",He,NHe);
1197:         if (He == 0  && V > NV && I == 0) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct V %d %d",V,NV);
1198:         if (He == 0  && V == 0 && I > NI) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NI %d %d",I,NI);
1199:         if (lc++ > DOF) SETERRQ4(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d NV %d NI %d MNHeV %",NHe,NV,NI,MNHeV);
1200:         if (He > 0 && V > 0) {  /* assumes the He are sorted in increasing order */
1201:           NHeV[V] = He;
1202:         }
1203:       }
1204:     }
1205:     PetscSynchronizedFGets(comm,fp,256,buff);
1206:   }
1207:   if (lc != DOF) SETERRQ5(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Recompile with correct NHe %d NV %d NI %d MNHeV %d Actual DOF %d",NHe,NV,NI,MNHeV,lc);
1208:   return(0);
1209: }