Actual source code: da2.c

  1: 
 2:  #include src/dm/da/daimpl.h

  6: /*@C
  7:       DAGetElements - Gets an array containing the indices (in local coordinates) 
  8:                  of all the local elements

 10:     Not Collective

 12:    Input Parameter:
 13: .     da - the DA object

 15:    Output Parameters:
 16: +     n - number of local elements
 17: -     e - the indices of the elements vertices

 19:    Level: intermediate

 21: .seealso: DAElementType, DASetElementType(), DARestoreElements()
 22: @*/
 23: PetscErrorCode DAGetElements(DA da,PetscInt *n,const PetscInt *e[])
 24: {
 28:   (da->ops->getelements)(da,n,e);
 29:   return(0);
 30: }

 34: /*@C
 35:       DARestoreElements - Returns an array containing the indices (in local coordinates) 
 36:                  of all the local elements obtained with DAGetElements()

 38:     Not Collective

 40:    Input Parameter:
 41: +     da - the DA object
 42: .     n - number of local elements
 43: -     e - the indices of the elements vertices

 45:    Level: intermediate

 47: .seealso: DAElementType, DASetElementType(), DAGetElements()
 48: @*/
 49: PetscErrorCode DARestoreElements(DA da,PetscInt *n,const PetscInt *e[])
 50: {
 54:   if (da->ops->restoreelements) {
 55:     (da->ops->restoreelements)(da,n,e);
 56:   }
 57:   return(0);
 58: }

 62: PetscErrorCode DAGetOwnershipRange(DA da,PetscInt **lx,PetscInt **ly,PetscInt **lz)
 63: {
 66:   if (lx) *lx = da->lx;
 67:   if (ly) *ly = da->ly;
 68:   if (lz) *lz = da->lz;
 69:   return(0);
 70: }

 74: PetscErrorCode DAView_2d(DA da,PetscViewer viewer)
 75: {
 77:   PetscMPIInt    rank;
 78:   PetscTruth     iascii,isdraw;

 81:   MPI_Comm_rank(da->comm,&rank);

 83:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
 84:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
 85:   if (iascii) {
 86:     PetscViewerASCIISynchronizedPrintf(viewer,"Processor [%d] M %D N %D m %D n %D w %D s %D\n",rank,da->M,
 87:                              da->N,da->m,da->n,da->w,da->s);
 88:     PetscViewerASCIISynchronizedPrintf(viewer,"X range of indices: %D %D, Y range of indices: %D %D\n",da->xs,da->xe,da->ys,da->ye);
 89:     PetscViewerFlush(viewer);
 90:   } else if (isdraw) {
 91:     PetscDraw       draw;
 92:     double     ymin = -1*da->s-1,ymax = da->N+da->s;
 93:     double     xmin = -1*da->s-1,xmax = da->M+da->s;
 94:     double     x,y;
 95:     PetscInt   base,*idx;
 96:     char       node[10];
 97:     PetscTruth isnull;
 98: 
 99:     PetscViewerDrawGetDraw(viewer,0,&draw);
100:     PetscDrawIsNull(draw,&isnull); if (isnull) return(0);
101:     if (!da->coordinates) {
102:       PetscDrawSetCoordinates(draw,xmin,ymin,xmax,ymax);
103:     }
104:     PetscDrawSynchronizedClear(draw);

106:     /* first processor draw all node lines */
107:     if (!rank) {
108:       ymin = 0.0; ymax = da->N - 1;
109:       for (xmin=0; xmin<da->M; xmin++) {
110:         PetscDrawLine(draw,xmin,ymin,xmin,ymax,PETSC_DRAW_BLACK);
111:       }
112:       xmin = 0.0; xmax = da->M - 1;
113:       for (ymin=0; ymin<da->N; ymin++) {
114:         PetscDrawLine(draw,xmin,ymin,xmax,ymin,PETSC_DRAW_BLACK);
115:       }
116:     }
117:     PetscDrawSynchronizedFlush(draw);
118:     PetscDrawPause(draw);

120:     /* draw my box */
121:     ymin = da->ys; ymax = da->ye - 1; xmin = da->xs/da->w;
122:     xmax =(da->xe-1)/da->w;
123:     PetscDrawLine(draw,xmin,ymin,xmax,ymin,PETSC_DRAW_RED);
124:     PetscDrawLine(draw,xmin,ymin,xmin,ymax,PETSC_DRAW_RED);
125:     PetscDrawLine(draw,xmin,ymax,xmax,ymax,PETSC_DRAW_RED);
126:     PetscDrawLine(draw,xmax,ymin,xmax,ymax,PETSC_DRAW_RED);

128:     /* put in numbers */
129:     base = (da->base)/da->w;
130:     for (y=ymin; y<=ymax; y++) {
131:       for (x=xmin; x<=xmax; x++) {
132:         sprintf(node,"%d",(int)base++);
133:         PetscDrawString(draw,x,y,PETSC_DRAW_BLACK,node);
134:       }
135:     }

137:     PetscDrawSynchronizedFlush(draw);
138:     PetscDrawPause(draw);
139:     /* overlay ghost numbers, useful for error checking */
140:     /* put in numbers */

142:     base = 0; idx = da->idx;
143:     ymin = da->Ys; ymax = da->Ye; xmin = da->Xs; xmax = da->Xe;
144:     for (y=ymin; y<ymax; y++) {
145:       for (x=xmin; x<xmax; x++) {
146:         if ((base % da->w) == 0) {
147:           sprintf(node,"%d",(int)(idx[base]/da->w));
148:           PetscDrawString(draw,x/da->w,y,PETSC_DRAW_BLUE,node);
149:         }
150:         base++;
151:       }
152:     }
153:     PetscDrawSynchronizedFlush(draw);
154:     PetscDrawPause(draw);
155:   } else {
156:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for DA2d",((PetscObject)viewer)->type_name);
157:   }
158:   return(0);
159: }

163: PetscErrorCode DAPublish_Petsc(PetscObject obj)
164: {
166:   return(0);
167: }

171: PetscErrorCode DAGetElements_2d_P1(DA da,PetscInt *n,const PetscInt *e[])
172: {
174:   PetscInt       i,j,cnt,xs,xe = da->xe,ys,ye = da->ye,Xs = da->Xs, Xe = da->Xe, Ys = da->Ys;

177:   if (!da->e) {
178:     if (da->xs == Xs) xs = da->xs; else xs = da->xs - 1;
179:     if (da->ys == Ys) ys = da->ys; else ys = da->ys - 1;
180:     da->ne = 2*(xe - xs - 1)*(ye - ys - 1);
181:     PetscMalloc((1 + 3*da->ne)*sizeof(PetscInt),&da->e);
182:     cnt    = 0;
183:     for (j=ys; j<ye-1; j++) {
184:       for (i=xs; i<xe-1; i++) {
185:         da->e[cnt]   = i - Xs + (j - Ys)*(Xe - Xs);
186:         da->e[cnt+1] = i - Xs + 1 + (j - Ys)*(Xe - Xs);
187:         da->e[cnt+2] = i - Xs + (j - Ys + 1)*(Xe - Xs);

189:         da->e[cnt+3] = i - Xs + 1 + (j - Ys + 1)*(Xe - Xs);
190:         da->e[cnt+4] = i - Xs + (j - Ys + 1)*(Xe - Xs);
191:         da->e[cnt+5] = i - Xs + 1 + (j - Ys)*(Xe - Xs);
192:         cnt += 6;
193:       }
194:     }
195:   }
196:   *n = da->ne;
197:   *e = da->e;
198:   return(0);
199: }


204: /*@C
205:    DACreate2d -  Creates an object that will manage the communication of  two-dimensional 
206:    regular array data that is distributed across some processors.

208:    Collective on MPI_Comm

210:    Input Parameters:
211: +  comm - MPI communicator
212: .  wrap - type of periodicity should the array have. 
213:          Use one of DA_NONPERIODIC, DA_XPERIODIC, DA_YPERIODIC, or DA_XYPERIODIC.
214: .  stencil_type - stencil type.  Use either DA_STENCIL_BOX or DA_STENCIL_STAR.
215: .  M,N - global dimension in each direction of the array (use -M and or -N to indicate that it may be set to a different value 
216:             from the command line with -da_grid_x <M> -da_grid_y <N>)
217: .  m,n - corresponding number of processors in each dimension 
218:          (or PETSC_DECIDE to have calculated)
219: .  dof - number of degrees of freedom per node
220: .  s - stencil width
221: -  lx, ly - arrays containing the number of nodes in each cell along
222:            the x and y coordinates, or PETSC_NULL. If non-null, these
223:            must be of length as m and n, and the corresponding
224:            m and n cannot be PETSC_DECIDE. The sum of the lx[] entries
225:            must be M, and the sum of the ly[] entries must be N.

227:    Output Parameter:
228: .  inra - the resulting distributed array object

230:    Options Database Key:
231: +  -da_view - Calls DAView() at the conclusion of DACreate2d()
232: .  -da_grid_x <nx> - number of grid points in x direction, if M < 0
233: .  -da_grid_y <ny> - number of grid points in y direction, if N < 0
234: .  -da_processors_x <nx> - number of processors in x direction
235: .  -da_processors_y <ny> - number of processors in y direction
236: .  -da_refine_x - refinement ratio in x direction
237: -  -da_refine_y - refinement ratio in y direction

239:    Level: beginner

241:    Notes:
242:    The stencil type DA_STENCIL_STAR with width 1 corresponds to the 
243:    standard 5-pt stencil, while DA_STENCIL_BOX with width 1 denotes
244:    the standard 9-pt stencil.

246:    The array data itself is NOT stored in the DA, it is stored in Vec objects;
247:    The appropriate vector objects can be obtained with calls to DACreateGlobalVector()
248:    and DACreateLocalVector() and calls to VecDuplicate() if more are needed.

250: .keywords: distributed array, create, two-dimensional

252: .seealso: DADestroy(), DAView(), DACreate1d(), DACreate3d(), DAGlobalToLocalBegin(), DAGetRefinementFactor(),
253:           DAGlobalToLocalEnd(), DALocalToGlobal(), DALocalToLocalBegin(), DALocalToLocalEnd(), DASetRefinementFactor(),
254:           DAGetInfo(), DACreateGlobalVector(), DACreateLocalVector(), DACreateNaturalVector(), DALoad(), DAView()

256: @*/
257: PetscErrorCode DACreate2d(MPI_Comm comm,DAPeriodicType wrap,DAStencilType stencil_type,
258:                           PetscInt M,PetscInt N,PetscInt m,PetscInt n,PetscInt dof,PetscInt s,PetscInt *lx,PetscInt *ly,DA *inra)
259: {
261:   PetscMPIInt    rank,size;
262:   PetscInt       xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,start,end;
263:   PetscInt       up,down,left,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn;
264:   PetscInt       xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count;
265:   PetscInt       s_x,s_y; /* s proportionalized to w */
266:   PetscInt       *flx = 0,*fly = 0;
267:   PetscInt       sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0,refine_x = 2, refine_y = 2,tM = M,tN = N;
268:   PetscTruth     flg1,flg2;
269:   DA             da;
270:   Vec            local,global;
271:   VecScatter     ltog,gtol;
272:   IS             to,from;

276:   *inra = 0;
277: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
278:   DMInitializePackage(PETSC_NULL);
279: #endif

281:   if (dof < 1) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Must have 1 or more degrees of freedom per node: %D",dof);
282:   if (s < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Stencil width cannot be negative: %D",s);

284:   PetscOptionsBegin(comm,PETSC_NULL,"2d DA Options","DA");
285:     if (M < 0){
286:       tM = -M;
287:       PetscOptionsInt("-da_grid_x","Number of grid points in x direction","DACreate2d",tM,&tM,PETSC_NULL);
288:     }
289:     if (N < 0){
290:       tN = -N;
291:       PetscOptionsInt("-da_grid_y","Number of grid points in y direction","DACreate2d",tN,&tN,PETSC_NULL);
292:     }
293:     PetscOptionsInt("-da_processors_x","Number of processors in x direction","DACreate2d",m,&m,PETSC_NULL);
294:     PetscOptionsInt("-da_processors_y","Number of processors in y direction","DACreate2d",n,&n,PETSC_NULL);
295:     PetscOptionsInt("-da_refine_x","Refinement ratio in x direction","DASetRefinementFactor",refine_x,&refine_x,PETSC_NULL);
296:     PetscOptionsInt("-da_refine_y","Refinement ratio in y direction","DASetRefinementFactor",refine_y,&refine_y,PETSC_NULL);
297:   PetscOptionsEnd();
298:   M = tM; N = tN;

300:   PetscHeaderCreate(da,_p_DA,struct _DAOps,DA_COOKIE,0,"DA",comm,DADestroy,DAView);
301:   PetscLogObjectCreate(da);
302:   da->bops->publish           = DAPublish_Petsc;
303:   da->ops->createglobalvector = DACreateGlobalVector;
304:   da->ops->getinterpolation   = DAGetInterpolation;
305:   da->ops->getcoloring        = DAGetColoring;
306:   da->ops->getmatrix          = DAGetMatrix;
307:   da->ops->refine             = DARefine;
308:   da->ops->getinjection       = DAGetInjection;
309:   da->ops->getelements        = DAGetElements_2d_P1;
310:   da->elementtype             = DA_ELEMENT_P1;

312:   PetscLogObjectMemory(da,sizeof(struct _p_DA));
313:   da->dim        = 2;
314:   da->interptype = DA_Q1;
315:   da->refine_x   = refine_x;
316:   da->refine_y   = refine_y;
317:   PetscMalloc(dof*sizeof(char*),&da->fieldname);
318:   PetscMemzero(da->fieldname,dof*sizeof(char*));

320:   MPI_Comm_size(comm,&size);
321:   MPI_Comm_rank(comm,&rank);

323:   if (m != PETSC_DECIDE) {
324:     if (m < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %D",m);}
325:     else if (m > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %D %d",m,size);}
326:   }
327:   if (n != PETSC_DECIDE) {
328:     if (n < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %D",n);}
329:     else if (n > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %D %d",n,size);}
330:   }

332:   if (m == PETSC_DECIDE || n == PETSC_DECIDE) {
333:     /* try for squarish distribution */
334:     /* This should use MPI_Dims_create instead */
335:     m = (PetscInt)(0.5 + sqrt(((double)M)*((double)size)/((double)N)));
336:     if (!m) m = 1;
337:     while (m > 0) {
338:       n = size/m;
339:       if (m*n == size) break;
340:       m--;
341:     }
342:     if (M > N && m < n) {PetscInt _m = m; m = n; n = _m;}
343:     if (m*n != size) SETERRQ(PETSC_ERR_PLIB,"Internally Created Bad Partition");
344:   } else if (m*n != size) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition");

346:   if (M < m) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Partition in x direction is too fine! %D %D",M,m);
347:   if (N < n) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Partition in y direction is too fine! %D %D",N,n);

349:   /*
350:      We should create an MPI Cartesian topology here, with reorder
351:      set to true.  That would create a NEW communicator that we would
352:      need to use for operations on this distributed array 
353:   */
354:   PetscOptionsHasName(PETSC_NULL,"-da_partition_nodes_at_end",&flg2);

356:   /* 
357:      Determine locally owned region 
358:      xs is the first local node number, x is the number of local nodes 
359:   */
360:   if (lx) { /* user sets distribution */
361:     x  = lx[rank % m];
362:     xs = 0;
363:     for (i=0; i<(rank % m); i++) {
364:       xs += lx[i];
365:     }
366:     left = xs;
367:     for (i=(rank % m); i<m; i++) {
368:       left += lx[i];
369:     }
370:     if (left != M) {
371:       SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M: %D %D",left,M);
372:     }
373:   } else if (flg2) {
374:     x = (M + rank%m)/m;
375:     if (m > 1 && x < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column width is too thin for stencil! %D %D",x,s);
376:     if (M/m == x) { xs = (rank % m)*x; }
377:     else          { xs = (rank % m)*(x-1) + (M+(rank % m))%(x*m); }
378:     SETERRQ(PETSC_ERR_SUP,"-da_partition_nodes_at_end not supported");
379:   } else { /* Normal PETSc distribution */
380:     x = M/m + ((M % m) > (rank % m));
381:     if (m > 1 && x < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column width is too thin for stencil! %D %D",x,s);
382:     if ((M % m) > (rank % m)) { xs = (rank % m)*x; }
383:     else                      { xs = (M % m)*(x+1) + ((rank % m)-(M % m))*x; }
384:     PetscMalloc(m*sizeof(PetscInt),&lx);
385:     flx = lx;
386:     for (i=0; i<m; i++) {
387:       lx[i] = M/m + ((M % m) > i);
388:     }
389:   }

391:   /* 
392:      Determine locally owned region 
393:      ys is the first local node number, y is the number of local nodes 
394:   */
395:   if (ly) { /* user sets distribution */
396:     y  = ly[rank/m];
397:     ys = 0;
398:     for (i=0; i<(rank/m); i++) {
399:       ys += ly[i];
400:     }
401:     left = ys;
402:     for (i=(rank/m); i<n; i++) {
403:       left += ly[i];
404:     }
405:     if (left != N) {
406:       SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Sum of ly across processors not equal to N: %D %D",left,N);
407:     }
408:   } else if (flg2) {
409:     y = (N + rank/m)/n;
410:     if (n > 1 && y < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row width is too thin for stencil! %D %D",y,s);
411:     if (N/n == y) { ys = (rank/m)*y;  }
412:     else          { ys = (rank/m)*(y-1) + (N+(rank/m))%(y*n); }
413:     SETERRQ(PETSC_ERR_SUP,"-da_partition_nodes_at_end not supported");
414:   } else { /* Normal PETSc distribution */
415:     y = N/n + ((N % n) > (rank/m));
416:     if (n > 1 && y < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row width is too thin for stencil! %D %D",y,s);
417:     if ((N % n) > (rank/m)) { ys = (rank/m)*y; }
418:     else                    { ys = (N % n)*(y+1) + ((rank/m)-(N % n))*y; }
419:     PetscMalloc(n*sizeof(PetscInt),&ly);
420:     fly  = ly;
421:     for (i=0; i<n; i++) {
422:       ly[i] = N/n + ((N % n) > i);
423:     }
424:   }

426:   xe = xs + x;
427:   ye = ys + y;

429:   /* determine ghost region */
430:   /* Assume No Periodicity */
431:   if (xs-s > 0) Xs = xs - s; else Xs = 0;
432:   if (ys-s > 0) Ys = ys - s; else Ys = 0;
433:   if (xe+s <= M) Xe = xe + s; else Xe = M;
434:   if (ye+s <= N) Ye = ye + s; else Ye = N;

436:   /* X Periodic */
437:   if (DAXPeriodic(wrap)){
438:     Xs = xs - s;
439:     Xe = xe + s;
440:   }

442:   /* Y Periodic */
443:   if (DAYPeriodic(wrap)){
444:     Ys = ys - s;
445:     Ye = ye + s;
446:   }

448:   /* Resize all X parameters to reflect w */
449:   x   *= dof;
450:   xs  *= dof;
451:   xe  *= dof;
452:   Xs  *= dof;
453:   Xe  *= dof;
454:   s_x = s*dof;
455:   s_y = s;

457:   /* determine starting point of each processor */
458:   nn    = x*y;
459:   PetscMalloc((2*size+1)*sizeof(PetscInt),&bases);
460:   ldims = bases+size+1;
461:   MPI_Allgather(&nn,1,MPIU_INT,ldims,1,MPIU_INT,comm);
462:   bases[0] = 0;
463:   for (i=1; i<=size; i++) {
464:     bases[i] = ldims[i-1];
465:   }
466:   for (i=1; i<=size; i++) {
467:     bases[i] += bases[i-1];
468:   }

470:   /* allocate the base parallel and sequential vectors */
471:   da->Nlocal = x*y;
472:   VecCreateMPIWithArray(comm,da->Nlocal,PETSC_DECIDE,0,&global);
473:   VecSetBlockSize(global,dof);
474:   da->nlocal = (Xe-Xs)*(Ye-Ys);
475:   VecCreateSeqWithArray(PETSC_COMM_SELF,da->nlocal,0,&local);
476:   VecSetBlockSize(local,dof);


479:   /* generate appropriate vector scatters */
480:   /* local to global inserts non-ghost point region into global */
481:   VecGetOwnershipRange(global,&start,&end);
482:   ISCreateStride(comm,x*y,start,1,&to);

484:   left  = xs - Xs; down  = ys - Ys; up    = down + y;
485:   PetscMalloc(x*(up - down)*sizeof(PetscInt),&idx);
486:   count = 0;
487:   for (i=down; i<up; i++) {
488:     for (j=0; j<x; j++) {
489:       idx[count++] = left + i*(Xe-Xs) + j;
490:     }
491:   }
492:   ISCreateGeneral(comm,count,idx,&from);
493:   PetscFree(idx);

495:   VecScatterCreate(local,from,global,to,&ltog);
496:   PetscLogObjectParent(da,to);
497:   PetscLogObjectParent(da,from);
498:   PetscLogObjectParent(da,ltog);
499:   ISDestroy(from);
500:   ISDestroy(to);

502:   /* global to local must include ghost points */
503:   if (stencil_type == DA_STENCIL_BOX) {
504:     ISCreateStride(comm,(Xe-Xs)*(Ye-Ys),0,1,&to);
505:   } else {
506:     /* must drop into cross shape region */
507:     /*       ---------|
508:             |  top    |
509:          |---         ---|
510:          |   middle      |
511:          |               |
512:          ----         ----
513:             | bottom  |
514:             -----------
515:         Xs xs        xe  Xe */
516:     /* bottom */
517:     left  = xs - Xs; down = ys - Ys; up    = down + y;
518:     count = down*(xe-xs) + (up-down)*(Xe-Xs) + (Ye-Ys-up)*(xe-xs);
519:     PetscMalloc(count*sizeof(PetscInt),&idx);
520:     count = 0;
521:     for (i=0; i<down; i++) {
522:       for (j=0; j<xe-xs; j++) {
523:         idx[count++] = left + i*(Xe-Xs) + j;
524:       }
525:     }
526:     /* middle */
527:     for (i=down; i<up; i++) {
528:       for (j=0; j<Xe-Xs; j++) {
529:         idx[count++] = i*(Xe-Xs) + j;
530:       }
531:     }
532:     /* top */
533:     for (i=up; i<Ye-Ys; i++) {
534:       for (j=0; j<xe-xs; j++) {
535:         idx[count++] = left + i*(Xe-Xs) + j;
536:       }
537:     }
538:     ISCreateGeneral(comm,count,idx,&to);
539:     PetscFree(idx);
540:   }


543:   /* determine who lies on each side of us stored in    n6 n7 n8
544:                                                         n3    n5
545:                                                         n0 n1 n2
546:   */

548:   /* Assume the Non-Periodic Case */
549:   n1 = rank - m;
550:   if (rank % m) {
551:     n0 = n1 - 1;
552:   } else {
553:     n0 = -1;
554:   }
555:   if ((rank+1) % m) {
556:     n2 = n1 + 1;
557:     n5 = rank + 1;
558:     n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
559:   } else {
560:     n2 = -1; n5 = -1; n8 = -1;
561:   }
562:   if (rank % m) {
563:     n3 = rank - 1;
564:     n6 = n3 + m; if (n6 >= m*n) n6 = -1;
565:   } else {
566:     n3 = -1; n6 = -1;
567:   }
568:   n7 = rank + m; if (n7 >= m*n) n7 = -1;


571:   /* Modify for Periodic Cases */
572:   if (wrap == DA_YPERIODIC) {  /* Handle Top and Bottom Sides */
573:     if (n1 < 0) n1 = rank + m * (n-1);
574:     if (n7 < 0) n7 = rank - m * (n-1);
575:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
576:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
577:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
578:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
579:   } else if (wrap == DA_XPERIODIC) { /* Handle Left and Right Sides */
580:     if (n3 < 0) n3 = rank + (m-1);
581:     if (n5 < 0) n5 = rank - (m-1);
582:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
583:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
584:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
585:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
586:   } else if (wrap == DA_XYPERIODIC) {

588:     /* Handle all four corners */
589:     if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
590:     if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
591:     if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
592:     if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;

594:     /* Handle Top and Bottom Sides */
595:     if (n1 < 0) n1 = rank + m * (n-1);
596:     if (n7 < 0) n7 = rank - m * (n-1);
597:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
598:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
599:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
600:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;

602:     /* Handle Left and Right Sides */
603:     if (n3 < 0) n3 = rank + (m-1);
604:     if (n5 < 0) n5 = rank - (m-1);
605:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
606:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
607:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
608:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
609:   }

611:   if (stencil_type == DA_STENCIL_STAR) {
612:     /* save corner processor numbers */
613:     sn0 = n0; sn2 = n2; sn6 = n6; sn8 = n8;
614:     n0 = n2 = n6 = n8 = -1;
615:   }

617:   PetscMalloc((x+2*s_x)*(y+2*s_y)*sizeof(PetscInt),&idx);
618:   PetscLogObjectMemory(da,(x+2*s_x)*(y+2*s_y)*sizeof(PetscInt));
619:   nn = 0;

621:   xbase = bases[rank];
622:   for (i=1; i<=s_y; i++) {
623:     if (n0 >= 0) { /* left below */
624:       x_t = lx[n0 % m]*dof;
625:       y_t = ly[(n0/m)];
626:       s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
627:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
628:     }
629:     if (n1 >= 0) { /* directly below */
630:       x_t = x;
631:       y_t = ly[(n1/m)];
632:       s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
633:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
634:     }
635:     if (n2 >= 0) { /* right below */
636:       x_t = lx[n2 % m]*dof;
637:       y_t = ly[(n2/m)];
638:       s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
639:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
640:     }
641:   }

643:   for (i=0; i<y; i++) {
644:     if (n3 >= 0) { /* directly left */
645:       x_t = lx[n3 % m]*dof;
646:       /* y_t = y; */
647:       s_t = bases[n3] + (i+1)*x_t - s_x;
648:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
649:     }

651:     for (j=0; j<x; j++) { idx[nn++] = xbase++; } /* interior */

653:     if (n5 >= 0) { /* directly right */
654:       x_t = lx[n5 % m]*dof;
655:       /* y_t = y; */
656:       s_t = bases[n5] + (i)*x_t;
657:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
658:     }
659:   }

661:   for (i=1; i<=s_y; i++) {
662:     if (n6 >= 0) { /* left above */
663:       x_t = lx[n6 % m]*dof;
664:       /* y_t = ly[(n6/m)]; */
665:       s_t = bases[n6] + (i)*x_t - s_x;
666:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
667:     }
668:     if (n7 >= 0) { /* directly above */
669:       x_t = x;
670:       /* y_t = ly[(n7/m)]; */
671:       s_t = bases[n7] + (i-1)*x_t;
672:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
673:     }
674:     if (n8 >= 0) { /* right above */
675:       x_t = lx[n8 % m]*dof;
676:       /* y_t = ly[(n8/m)]; */
677:       s_t = bases[n8] + (i-1)*x_t;
678:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
679:     }
680:   }

682:   base = bases[rank];
683:   ISCreateGeneral(comm,nn,idx,&from);
684:   VecScatterCreate(global,from,local,to,&gtol);
685:   PetscLogObjectParent(da,to);
686:   PetscLogObjectParent(da,from);
687:   PetscLogObjectParent(da,gtol);
688:   ISDestroy(to);
689:   ISDestroy(from);

691:   if (stencil_type == DA_STENCIL_STAR) {
692:     /*
693:         Recompute the local to global mappings, this time keeping the 
694:       information about the cross corner processor numbers.
695:     */
696:     n0 = sn0; n2 = sn2; n6 = sn6; n8 = sn8;
697:     nn = 0;
698:     xbase = bases[rank];
699:     for (i=1; i<=s_y; i++) {
700:       if (n0 >= 0) { /* left below */
701:         x_t = lx[n0 % m]*dof;
702:         y_t = ly[(n0/m)];
703:         s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
704:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
705:       }
706:       if (n1 >= 0) { /* directly below */
707:         x_t = x;
708:         y_t = ly[(n1/m)];
709:         s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
710:         for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
711:       }
712:       if (n2 >= 0) { /* right below */
713:         x_t = lx[n2 % m]*dof;
714:         y_t = ly[(n2/m)];
715:         s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
716:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
717:       }
718:     }

720:     for (i=0; i<y; i++) {
721:       if (n3 >= 0) { /* directly left */
722:         x_t = lx[n3 % m]*dof;
723:         /* y_t = y; */
724:         s_t = bases[n3] + (i+1)*x_t - s_x;
725:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
726:       }

728:       for (j=0; j<x; j++) { idx[nn++] = xbase++; } /* interior */

730:       if (n5 >= 0) { /* directly right */
731:         x_t = lx[n5 % m]*dof;
732:         /* y_t = y; */
733:         s_t = bases[n5] + (i)*x_t;
734:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
735:       }
736:     }

738:     for (i=1; i<=s_y; i++) {
739:       if (n6 >= 0) { /* left above */
740:         x_t = lx[n6 % m]*dof;
741:         /* y_t = ly[(n6/m)]; */
742:         s_t = bases[n6] + (i)*x_t - s_x;
743:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
744:       }
745:       if (n7 >= 0) { /* directly above */
746:         x_t = x;
747:         /* y_t = ly[(n7/m)]; */
748:         s_t = bases[n7] + (i-1)*x_t;
749:         for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
750:       }
751:       if (n8 >= 0) { /* right above */
752:         x_t = lx[n8 % m]*dof;
753:         /* y_t = ly[(n8/m)]; */
754:         s_t = bases[n8] + (i-1)*x_t;
755:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
756:       }
757:     }
758:   }
759:   PetscFree(bases);

761:   da->M  = M;  da->N  = N;  da->m  = m;  da->n  = n;  da->w = dof;  da->s = s;
762:   da->xs = xs; da->xe = xe; da->ys = ys; da->ye = ye; da->zs = 0; da->ze = 1;
763:   da->Xs = Xs; da->Xe = Xe; da->Ys = Ys; da->Ye = Ye; da->Zs = 0; da->Ze = 1;
764:   da->P  = 1;  da->p  = 1;

766:   VecDestroy(local);
767:   VecDestroy(global);

769:   da->gtol         = gtol;
770:   da->ltog         = ltog;
771:   da->idx          = idx;
772:   da->Nl           = nn;
773:   da->base         = base;
774:   da->wrap         = wrap;
775:   da->ops->view    = DAView_2d;
776:   da->stencil_type = stencil_type;

778:   /* 
779:      Set the local to global ordering in the global vector, this allows use
780:      of VecSetValuesLocal().
781:   */
782:   ISLocalToGlobalMappingCreateNC(comm,nn,idx,&da->ltogmap);
783:   ISLocalToGlobalMappingBlock(da->ltogmap,da->w,&da->ltogmapb);
784:   PetscLogObjectParent(da,da->ltogmap);

786:   *inra = da;

788:   da->ltol = PETSC_NULL;
789:   da->ao   = PETSC_NULL;


792:   if (!flx) {
793:     PetscMalloc(m*sizeof(PetscInt),&flx);
794:     PetscMemcpy(flx,lx,m*sizeof(PetscInt));
795:   }
796:   if (!fly) {
797:     PetscMalloc(n*sizeof(PetscInt),&fly);
798:     PetscMemcpy(fly,ly,n*sizeof(PetscInt));
799:   }
800:   da->lx = flx;
801:   da->ly = fly;

803:   PetscOptionsHasName(PETSC_NULL,"-da_view",&flg1);
804:   if (flg1) {DAView(da,PETSC_VIEWER_STDOUT_(da->comm));}
805:   PetscOptionsHasName(PETSC_NULL,"-da_view_draw",&flg1);
806:   if (flg1) {DAView(da,PETSC_VIEWER_DRAW_(da->comm));}
807:   PetscOptionsHasName(PETSC_NULL,"-help",&flg1);
808:   if (flg1) {DAPrintHelp(da);}

810:   PetscPublishAll(da);
811:   return(0);
812: }

816: /*@
817:    DAPrintHelp - Prints command line options for DA.

819:    Collective on DA

821:    Input Parameters:
822: .  da - the distributed array

824:    Level: intermediate

826: .seealso: DACreate1d(), DACreate2d(), DACreate3d()

828: .keywords: DA, help

830: @*/
831: PetscErrorCode DAPrintHelp(DA da)
832: {
833:   static PetscTruth called = PETSC_FALSE;
834:   MPI_Comm          comm;
835:   PetscErrorCode    ierr;


840:   comm = da->comm;
841:   if (!called) {
842:     (*PetscHelpPrintf)(comm,"General Distributed Array (DA) options:\n");
843:     (*PetscHelpPrintf)(comm,"  -da_view: print DA distribution to screen\n");
844:     (*PetscHelpPrintf)(comm,"  -da_view_draw: display DA in window\n");
845:     called = PETSC_TRUE;
846:   }
847:   return(0);
848: }

852: /*@C
853:    DARefine - Creates a new distributed array that is a refinement of a given
854:    distributed array.

856:    Collective on DA

858:    Input Parameter:
859: +  da - initial distributed array
860: -  comm - communicator to contain refined DA, must be either same as the da communicator or include the 
861:           da communicator and be 2, 4, or 8 times larger. Currently ignored

863:    Output Parameter:
864: .  daref - refined distributed array

866:    Level: advanced

868:    Note:
869:    Currently, refinement consists of just doubling the number of grid spaces
870:    in each dimension of the DA.

872: .keywords:  distributed array, refine

874: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy()
875: @*/
876: PetscErrorCode DARefine(DA da,MPI_Comm comm,DA *daref)
877: {
879:   PetscInt       M,N,P;
880:   DA             da2;


886:   if (DAXPeriodic(da->wrap) || da->interptype == DA_Q0){
887:     M = da->refine_x*da->M;
888:   } else {
889:     M = 1 + da->refine_x*(da->M - 1);
890:   }
891:   if (DAYPeriodic(da->wrap) || da->interptype == DA_Q0){
892:     N = da->refine_y*da->N;
893:   } else {
894:     N = 1 + da->refine_y*(da->N - 1);
895:   }
896:   if (DAZPeriodic(da->wrap) || da->interptype == DA_Q0){
897:     P = da->refine_z*da->P;
898:   } else {
899:     P = 1 + da->refine_z*(da->P - 1);
900:   }
901:   if (da->dim == 1) {
902:     DACreate1d(da->comm,da->wrap,M,da->w,da->s,PETSC_NULL,&da2);
903:   } else if (da->dim == 2) {
904:     DACreate2d(da->comm,da->wrap,da->stencil_type,M,N,da->m,da->n,da->w,da->s,PETSC_NULL,PETSC_NULL,&da2);
905:   } else if (da->dim == 3) {
906:     DACreate3d(da->comm,da->wrap,da->stencil_type,M,N,P,da->m,da->n,da->p,da->w,da->s,0,0,0,&da2);
907:   }
908:   /* allow overloaded (user replaced) operations to be inherited by refinement clones */
909:   da2->ops->getmatrix        = da->ops->getmatrix;
910:   da2->ops->getinterpolation = da->ops->getinterpolation;
911:   da2->ops->getcoloring      = da->ops->getcoloring;
912: 
913:   /* copy fill information if given */
914:   if (da->dfill) {
915:     PetscMalloc((da->dfill[da->w]+da->w+1)*sizeof(PetscInt),&da2->dfill);
916:     PetscMemcpy(da2->dfill,da->dfill,(da->dfill[da->w]+da->w+1)*sizeof(PetscInt));
917:   }
918:   if (da->ofill) {
919:     PetscMalloc((da->ofill[da->w]+da->w+1)*sizeof(PetscInt),&da2->ofill);
920:     PetscMemcpy(da2->ofill,da->ofill,(da->ofill[da->w]+da->w+1)*sizeof(PetscInt));
921:   }
922:   /* copy the refine information */
923:   da2->refine_x = da->refine_x;
924:   da2->refine_y = da->refine_y;
925:   da2->refine_z = da->refine_z;
926:   *daref = da2;
927:   return(0);
928: }

930: /*@C
931:      DASetRefinementFactor - Set the ratios that the DA grid is refined

933:     Collective on DA

935:   Input Parameters:
936: +    da - the DA object
937: .    refine_x - ratio of fine grid to coarse in x direction (2 by default)
938: .    refine_y - ratio of fine grid to coarse in y direction (2 by default)
939: -    refine_z - ratio of fine grid to coarse in z direction (2 by default)

941:   Options Database:
942: +  -da_refine_x - refinement ratio in x direction
943: .  -da_refine_y - refinement ratio in y direction
944: -  -da_refine_y - refinement ratio in z direction

946:   Level: intermediate

948:     Notes: Pass PETSC_IGNORE to leave a value unchanged

950: .seealso: DARefine(), DAGetRefinementFactor()
951: @*/
952: PetscErrorCode DASetRefinementFactor(DA da, PetscInt refine_x, PetscInt refine_y,PetscInt refine_z)
953: {
955:   if (refine_x > 0) da->refine_x = refine_x;
956:   if (refine_y > 0) da->refine_y = refine_y;
957:   if (refine_z > 0) da->refine_z = refine_z;
958:   return(0);
959: }

961: /*@C
962:      DAGetRefinementFactor - Gets the ratios that the DA grid is refined

964:     Not Collective

966:   Input Parameter:
967: .    da - the DA object

969:   Output Parameters:
970: +    refine_x - ratio of fine grid to coarse in x direction (2 by default)
971: .    refine_y - ratio of fine grid to coarse in y direction (2 by default)
972: -    refine_z - ratio of fine grid to coarse in z direction (2 by default)

974:   Level: intermediate

976:     Notes: Pass PETSC_NULL for values you do not need

978: .seealso: DARefine(), DASetRefinementFactor()
979: @*/
980: PetscErrorCode DAGetRefinementFactor(DA da, PetscInt *refine_x, PetscInt *refine_y,PetscInt *refine_z)
981: {
983:   if (refine_x) *refine_x = da->refine_x;
984:   if (refine_y) *refine_y = da->refine_y;
985:   if (refine_z) *refine_z = da->refine_z;
986:   return(0);
987: }

989: /*@C
990:      DASetGetMatrix - Sets the routine used by the DA to allocate a matrix.

992:     Collective on DA

994:   Input Parameters:
995: +    da - the DA object
996: -    f - the function that allocates the matrix for that specific DA

998:   Level: developer

1000:    Notes: See DASetBlockFills() that provides a simple way to provide the nonzero structure for 
1001:        the diagonal and off-diagonal blocks of the matrix

1003: .seealso: DAGetMatrix(), DASetBlockFills()
1004: @*/
1005: PetscErrorCode DASetGetMatrix(DA da,PetscErrorCode (*f)(DA,const MatType,Mat*))
1006: {
1008:   da->ops->getmatrix = f;
1009:   return(0);
1010: }

1012: /*
1013:       M is number of grid points 
1014:       m is number of processors

1016: */
1019: PetscErrorCode DASplitComm2d(MPI_Comm comm,PetscInt M,PetscInt N,PetscInt sw,MPI_Comm *outcomm)
1020: {
1022:   PetscInt       m,n = 0,x = 0,y = 0;
1023:   PetscMPIInt    size,csize,rank;

1026:   MPI_Comm_size(comm,&size);
1027:   MPI_Comm_rank(comm,&rank);

1029:   csize = 4*size;
1030:   do {
1031:     if (csize % 4) SETERRQ4(PETSC_ERR_ARG_INCOMP,"Cannot split communicator of size %d tried %d %D %D",size,csize,x,y);
1032:     csize   = csize/4;
1033: 
1034:     m = (PetscInt)(0.5 + sqrt(((double)M)*((double)csize)/((double)N)));
1035:     if (!m) m = 1;
1036:     while (m > 0) {
1037:       n = csize/m;
1038:       if (m*n == csize) break;
1039:       m--;
1040:     }
1041:     if (M > N && m < n) {PetscInt _m = m; m = n; n = _m;}

1043:     x = M/m + ((M % m) > ((csize-1) % m));
1044:     y = (N + (csize-1)/m)/n;
1045:   } while ((x < 4 || y < 4) && csize > 1);
1046:   if (size != csize) {
1047:     MPI_Group    entire_group,sub_group;
1048:     PetscMPIInt  i,*groupies;

1050:     MPI_Comm_group(comm,&entire_group);
1051:     PetscMalloc(csize*sizeof(PetscInt),&groupies);
1052:     for (i=0; i<csize; i++) {
1053:       groupies[i] = (rank/csize)*csize + i;
1054:     }
1055:     MPI_Group_incl(entire_group,csize,groupies,&sub_group);
1056:     PetscFree(groupies);
1057:     MPI_Comm_create(comm,sub_group,outcomm);
1058:     MPI_Group_free(&entire_group);
1059:     MPI_Group_free(&sub_group);
1060:     PetscLogInfo(0,"Creating redundant coarse problems of size %d\n",csize);
1061:   } else {
1062:     *outcomm = comm;
1063:   }
1064:   return(0);
1065: }

1069: /*@C
1070:        DASetLocalFunction - Caches in a DA a local function. 

1072:    Collective on DA

1074:    Input Parameter:
1075: +  da - initial distributed array
1076: -  lf - the local function

1078:    Level: intermediate

1080:    Notes: The routine SNESDAFormFunction() uses this the cached function to evaluate the user provided function.

1082: .keywords:  distributed array, refine

1084: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunctioni()
1085: @*/
1086: PetscErrorCode DASetLocalFunction(DA da,DALocalFunction1 lf)
1087: {
1090:   da->lf    = lf;
1091:   return(0);
1092: }

1096: /*@C
1097:        DASetLocalFunctioni - Caches in a DA a local function that evaluates a single component

1099:    Collective on DA

1101:    Input Parameter:
1102: +  da - initial distributed array
1103: -  lfi - the local function

1105:    Level: intermediate

1107: .keywords:  distributed array, refine

1109: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1110: @*/
1111: PetscErrorCode DASetLocalFunctioni(DA da,PetscErrorCode (*lfi)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*))
1112: {
1115:   da->lfi = lfi;
1116:   return(0);
1117: }


1122: PetscErrorCode DASetLocalAdicFunction_Private(DA da,DALocalFunction1 ad_lf)
1123: {
1126:   da->adic_lf = ad_lf;
1127:   return(0);
1128: }

1130: /*MC
1131:        DASetLocalAdicFunctioni - Caches in a DA a local functioni computed by ADIC/ADIFOR

1133:    Collective on DA

1135:    Synopsis:
1136:    PetscErrorCode DASetLocalAdicFunctioni(DA da,PetscInt (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1137:    
1138:    Input Parameter:
1139: +  da - initial distributed array
1140: -  ad_lfi - the local function as computed by ADIC/ADIFOR

1142:    Level: intermediate

1144: .keywords:  distributed array, refine

1146: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1147:           DASetLocalJacobian(), DASetLocalFunctioni()
1148: M*/

1152: PetscErrorCode DASetLocalAdicFunctioni_Private(DA da,PetscErrorCode (*ad_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1153: {
1156:   da->adic_lfi = ad_lfi;
1157:   return(0);
1158: }

1160: /*MC
1161:        DASetLocalAdicMFFunctioni - Caches in a DA a local functioni computed by ADIC/ADIFOR

1163:    Collective on DA

1165:    Synopsis:
1166:    PetscErrorCode  DASetLocalAdicFunctioni(DA da,int (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1167:    
1168:    Input Parameter:
1169: +  da - initial distributed array
1170: -  admf_lfi - the local matrix-free function as computed by ADIC/ADIFOR

1172:    Level: intermediate

1174: .keywords:  distributed array, refine

1176: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1177:           DASetLocalJacobian(), DASetLocalFunctioni()
1178: M*/

1182: PetscErrorCode DASetLocalAdicMFFunctioni_Private(DA da,PetscErrorCode (*admf_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1183: {
1186:   da->adicmf_lfi = admf_lfi;
1187:   return(0);
1188: }

1190: /*MC
1191:        DASetLocalAdicMFFunction - Caches in a DA a local function computed by ADIC/ADIFOR

1193:    Collective on DA

1195:    Synopsis:
1196:    PetscErrorCode DASetLocalAdicMFFunction(DA da,DALocalFunction1 ad_lf)
1197:    
1198:    Input Parameter:
1199: +  da - initial distributed array
1200: -  ad_lf - the local function as computed by ADIC/ADIFOR

1202:    Level: intermediate

1204: .keywords:  distributed array, refine

1206: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1207:           DASetLocalJacobian()
1208: M*/

1212: PetscErrorCode DASetLocalAdicMFFunction_Private(DA da,DALocalFunction1 ad_lf)
1213: {
1216:   da->adicmf_lf = ad_lf;
1217:   return(0);
1218: }

1220: /*@C
1221:        DASetLocalJacobian - Caches in a DA a local Jacobian

1223:    Collective on DA

1225:    
1226:    Input Parameter:
1227: +  da - initial distributed array
1228: -  lj - the local Jacobian

1230:    Level: intermediate

1232:    Notes: The routine SNESDAFormFunction() uses this the cached function to evaluate the user provided function.

1234: .keywords:  distributed array, refine

1236: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1237: @*/
1240: PetscErrorCode DASetLocalJacobian(DA da,DALocalFunction1 lj)
1241: {
1244:   da->lj    = lj;
1245:   return(0);
1246: }

1250: /*@C
1251:        DAGetLocalFunction - Gets from a DA a local function and its ADIC/ADIFOR Jacobian

1253:    Collective on DA

1255:    Input Parameter:
1256: .  da - initial distributed array

1258:    Output Parameters:
1259: .  lf - the local function

1261:    Level: intermediate

1263: .keywords:  distributed array, refine

1265: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DASetLocalFunction()
1266: @*/
1267: PetscErrorCode DAGetLocalFunction(DA da,DALocalFunction1 *lf)
1268: {
1271:   if (lf)       *lf = da->lf;
1272:   return(0);
1273: }

1277: /*@
1278:     DAFormFunction1 - Evaluates a user provided function on each processor that 
1279:         share a DA

1281:    Input Parameters:
1282: +    da - the DA that defines the grid
1283: .    vu - input vector
1284: .    vfu - output vector 
1285: -    w - any user data

1287:     Notes: Does NOT do ghost updates on vu upon entry

1289:     Level: advanced

1291: .seealso: DAComputeJacobian1WithAdic()

1293: @*/
1294: PetscErrorCode DAFormFunction1(DA da,Vec vu,Vec vfu,void *w)
1295: {
1297:   void           *u,*fu;
1298:   DALocalInfo    info;
1299: 

1302:   DAGetLocalInfo(da,&info);
1303:   DAVecGetArray(da,vu,&u);
1304:   DAVecGetArray(da,vfu,&fu);

1306:   (*da->lf)(&info,u,fu,w);

1308:   DAVecRestoreArray(da,vu,&u);
1309:   DAVecRestoreArray(da,vfu,&fu);
1310:   return(0);
1311: }

1315: PetscErrorCode DAFormFunctioniTest1(DA da,void *w)
1316: {
1317:   Vec            vu,fu,fui;
1319:   PetscInt       i,n;
1320:   PetscScalar    *ui,mone = -1.0;
1321:   PetscRandom    rnd;
1322:   PetscReal      norm;

1325:   DAGetLocalVector(da,&vu);
1326:   PetscRandomCreate(PETSC_COMM_SELF,RANDOM_DEFAULT,&rnd);
1327:   VecSetRandom(rnd,vu);
1328:   PetscRandomDestroy(rnd);

1330:   DAGetGlobalVector(da,&fu);
1331:   DAGetGlobalVector(da,&fui);
1332: 
1333:   DAFormFunction1(da,vu,fu,w);

1335:   VecGetArray(fui,&ui);
1336:   VecGetLocalSize(fui,&n);
1337:   for (i=0; i<n; i++) {
1338:     DAFormFunctioni1(da,i,vu,ui+i,w);
1339:   }
1340:   VecRestoreArray(fui,&ui);

1342:   VecAXPY(&mone,fu,fui);
1343:   VecNorm(fui,NORM_2,&norm);
1344:   PetscPrintf(da->comm,"Norm of difference in vectors %g\n",norm);
1345:   VecView(fu,0);
1346:   VecView(fui,0);

1348:   DARestoreLocalVector(da,&vu);
1349:   DARestoreGlobalVector(da,&fu);
1350:   DARestoreGlobalVector(da,&fui);
1351:   return(0);
1352: }

1356: /*@
1357:     DAFormFunctioni1 - Evaluates a user provided function

1359:    Input Parameters:
1360: +    da - the DA that defines the grid
1361: .    i - the component of the function we wish to compute (must be local)
1362: .    vu - input vector
1363: .    vfu - output value
1364: -    w - any user data

1366:     Notes: Does NOT do ghost updates on vu upon entry

1368:     Level: advanced

1370: .seealso: DAComputeJacobian1WithAdic()

1372: @*/
1373: PetscErrorCode DAFormFunctioni1(DA da,PetscInt i,Vec vu,PetscScalar *vfu,void *w)
1374: {
1376:   void           *u;
1377:   DALocalInfo    info;
1378:   MatStencil     stencil;
1379: 

1382:   DAGetLocalInfo(da,&info);
1383:   DAVecGetArray(da,vu,&u);

1385:   /* figure out stencil value from i */
1386:   stencil.c = i % info.dof;
1387:   stencil.i = (i % (info.xm*info.dof))/info.dof;
1388:   stencil.j = (i % (info.xm*info.ym*info.dof))/(info.xm*info.dof);
1389:   stencil.k = i/(info.xm*info.ym*info.dof);

1391:   (*da->lfi)(&info,&stencil,u,vfu,w);

1393:   DAVecRestoreArray(da,vu,&u);
1394:   return(0);
1395: }

1397: #if defined(new)
1400: /*
1401:   DAGetDiagonal_MFFD - Gets the diagonal for a matrix free matrix where local
1402:     function lives on a DA

1404:         y ~= (F(u + ha) - F(u))/h, 
1405:   where F = nonlinear function, as set by SNESSetFunction()
1406:         u = current iterate
1407:         h = difference interval
1408: */
1409: PetscErrorCode DAGetDiagonal_MFFD(DA da,Vec U,Vec a)
1410: {
1411:   PetscScalar    h,*aa,*ww,v;
1412:   PetscReal      epsilon = PETSC_SQRT_MACHINE_EPSILON,umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
1414:   PetscInt       gI,nI;
1415:   MatStencil     stencil;
1416:   DALocalInfo    info;
1417: 
1419:   (*ctx->func)(0,U,a,ctx->funcctx);
1420:   (*ctx->funcisetbase)(U,ctx->funcctx);

1422:   VecGetArray(U,&ww);
1423:   VecGetArray(a,&aa);
1424: 
1425:   nI = 0;
1426:     h  = ww[gI];
1427:     if (h == 0.0) h = 1.0;
1428: #if !defined(PETSC_USE_COMPLEX)
1429:     if (h < umin && h >= 0.0)      h = umin;
1430:     else if (h < 0.0 && h > -umin) h = -umin;
1431: #else
1432:     if (PetscAbsScalar(h) < umin && PetscRealPart(h) >= 0.0)     h = umin;
1433:     else if (PetscRealPart(h) < 0.0 && PetscAbsScalar(h) < umin) h = -umin;
1434: #endif
1435:     h     *= epsilon;
1436: 
1437:     ww[gI += h;
1438:     (*ctx->funci)(i,w,&v,ctx->funcctx);
1439:     aa[nI]  = (v - aa[nI])/h;
1440:     ww[gI] -= h;
1441:     nI++;
1442:   }
1443:   VecRestoreArray(U,&ww);
1444:   VecRestoreArray(a,&aa);
1445:   return(0);
1446: }
1447: #endif

1449: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1451: #include "adic/ad_utils.h"

1456: /*@
1457:     DAComputeJacobian1WithAdic - Evaluates a adiC provided Jacobian function on each processor that 
1458:         share a DA

1460:    Input Parameters:
1461: +    da - the DA that defines the grid
1462: .    vu - input vector (ghosted)
1463: .    J - output matrix
1464: -    w - any user data

1466:    Level: advanced

1468:     Notes: Does NOT do ghost updates on vu upon entry

1470: .seealso: DAFormFunction1()

1472: @*/
1473: PetscErrorCode DAComputeJacobian1WithAdic(DA da,Vec vu,Mat J,void *w)
1474: {
1476:   PetscInt       gtdof,tdof;
1477:   PetscScalar    *ustart;
1478:   DALocalInfo    info;
1479:   void           *ad_u,*ad_f,*ad_ustart,*ad_fstart;
1480:   ISColoring     iscoloring;

1483:   DAGetLocalInfo(da,&info);

1485:   PetscADResetIndep();

1487:   /* get space for derivative objects.  */
1488:   DAGetAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1489:   DAGetAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1490:   VecGetArray(vu,&ustart);
1491:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);

1493:   PetscADSetValueAndColor(ad_ustart,gtdof,iscoloring->colors,ustart);

1495:   VecRestoreArray(vu,&ustart);
1496:   ISColoringDestroy(iscoloring);
1497:   PetscADIncrementTotalGradSize(iscoloring->n);
1498:   PetscADSetIndepDone();

1500:   PetscLogEventBegin(DA_LocalADFunction,0,0,0,0);
1501:   (*da->adic_lf)(&info,ad_u,ad_f,w);
1502:   PetscLogEventEnd(DA_LocalADFunction,0,0,0,0);

1504:   /* stick the values into the matrix */
1505:   MatSetValuesAdic(J,(PetscScalar**)ad_fstart);

1507:   /* return space for derivative objects.  */
1508:   DARestoreAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1509:   DARestoreAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1510:   return(0);
1511: }

1515: /*@C
1516:     DAMultiplyByJacobian1WithAdic - Applies an ADIC-provided Jacobian function to a vector on 
1517:     each processor that shares a DA.

1519:     Input Parameters:
1520: +   da - the DA that defines the grid
1521: .   vu - Jacobian is computed at this point (ghosted)
1522: .   v - product is done on this vector (ghosted)
1523: .   fu - output vector = J(vu)*v (not ghosted)
1524: -   w - any user data

1526:     Notes: 
1527:     This routine does NOT do ghost updates on vu upon entry.

1529:    Level: advanced

1531: .seealso: DAFormFunction1()

1533: @*/
1534: PetscErrorCode DAMultiplyByJacobian1WithAdic(DA da,Vec vu,Vec v,Vec f,void *w)
1535: {
1537:   PetscInt       i,gtdof,tdof;
1538:   PetscScalar    *avu,*av,*af,*ad_vustart,*ad_fstart;
1539:   DALocalInfo    info;
1540:   void           *ad_vu,*ad_f;

1543:   DAGetLocalInfo(da,&info);

1545:   /* get space for derivative objects.  */
1546:   DAGetAdicMFArray(da,PETSC_TRUE,(void **)&ad_vu,(void**)&ad_vustart,&gtdof);
1547:   DAGetAdicMFArray(da,PETSC_FALSE,(void **)&ad_f,(void**)&ad_fstart,&tdof);

1549:   /* copy input vector into derivative object */
1550:   VecGetArray(vu,&avu);
1551:   VecGetArray(v,&av);
1552:   for (i=0; i<gtdof; i++) {
1553:     ad_vustart[2*i]   = avu[i];
1554:     ad_vustart[2*i+1] = av[i];
1555:   }
1556:   VecRestoreArray(vu,&avu);
1557:   VecRestoreArray(v,&av);

1559:   PetscADResetIndep();
1560:   PetscADIncrementTotalGradSize(1);
1561:   PetscADSetIndepDone();

1563:   (*da->adicmf_lf)(&info,ad_vu,ad_f,w);

1565:   /* stick the values into the vector */
1566:   VecGetArray(f,&af);
1567:   for (i=0; i<tdof; i++) {
1568:     af[i] = ad_fstart[2*i+1];
1569:   }
1570:   VecRestoreArray(f,&af);

1572:   /* return space for derivative objects.  */
1573:   DARestoreAdicMFArray(da,PETSC_TRUE,(void **)&ad_vu,(void**)&ad_vustart,&gtdof);
1574:   DARestoreAdicMFArray(da,PETSC_FALSE,(void **)&ad_f,(void**)&ad_fstart,&tdof);
1575:   return(0);
1576: }


1579: #else

1583: PetscErrorCode DAComputeJacobian1WithAdic(DA da,Vec vu,Mat J,void *w)
1584: {
1586:   SETERRQ(PETSC_ERR_SUP_SYS,"Must compile with bmake/PETSC_ARCH/packages flag PETSC_HAVE_ADIC for this routine");
1587: }

1591: PetscErrorCode DAMultiplyByJacobian1WithAdic(DA da,Vec vu,Vec v,Vec f,void *w)
1592: {
1594:   SETERRQ(PETSC_ERR_SUP_SYS,"Must compile with bmake/PETSC_ARCH/packages flag PETSC_HAVE_ADIC for this routine");
1595: }

1597: #endif

1601: /*@
1602:     DAComputeJacobian1 - Evaluates a local Jacobian function on each processor that 
1603:         share a DA

1605:    Input Parameters:
1606: +    da - the DA that defines the grid
1607: .    vu - input vector (ghosted)
1608: .    J - output matrix
1609: -    w - any user data

1611:     Notes: Does NOT do ghost updates on vu upon entry

1613:     Level: advanced

1615: .seealso: DAFormFunction1()

1617: @*/
1618: PetscErrorCode DAComputeJacobian1(DA da,Vec vu,Mat J,void *w)
1619: {
1621:   void           *u;
1622:   DALocalInfo    info;

1625:   DAGetLocalInfo(da,&info);
1626:   DAVecGetArray(da,vu,&u);
1627:   (*da->lj)(&info,u,J,w);
1628:   DAVecRestoreArray(da,vu,&u);
1629:   return(0);
1630: }


1635: /*
1636:     DAComputeJacobian1WithAdifor - Evaluates a ADIFOR provided Jacobian local function on each processor that 
1637:         share a DA

1639:    Input Parameters:
1640: +    da - the DA that defines the grid
1641: .    vu - input vector (ghosted)
1642: .    J - output matrix
1643: -    w - any user data

1645:     Notes: Does NOT do ghost updates on vu upon entry

1647: .seealso: DAFormFunction1()

1649: */
1650: PetscErrorCode DAComputeJacobian1WithAdifor(DA da,Vec vu,Mat J,void *w)
1651: {
1652:   PetscErrorCode  ierr;
1653:   PetscInt        i,Nc,N;
1654:   ISColoringValue *color;
1655:   DALocalInfo     info;
1656:   PetscScalar     *u,*g_u,*g_f,*f,*p_u;
1657:   ISColoring      iscoloring;
1658:   void            (*lf)(PetscInt*,DALocalInfo*,PetscScalar*,PetscScalar*,PetscInt*,PetscScalar*,PetscScalar*,PetscInt*,void*,PetscErrorCode*) =
1659:                   (void (*)(PetscInt*,DALocalInfo*,PetscScalar*,PetscScalar*,PetscInt*,PetscScalar*,PetscScalar*,PetscInt*,void*,PetscErrorCode*))*da->adifor_lf;

1662:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);
1663:   Nc   = iscoloring->n;
1664:   DAGetLocalInfo(da,&info);
1665:   N    = info.gxm*info.gym*info.gzm*info.dof;

1667:   /* get space for derivative objects.  */
1668:   PetscMalloc(Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar),&g_u);
1669:   PetscMemzero(g_u,Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar));
1670:   p_u   = g_u;
1671:   color = iscoloring->colors;
1672:   for (i=0; i<N; i++) {
1673:     p_u[*color++] = 1.0;
1674:     p_u          += Nc;
1675:   }
1676:   ISColoringDestroy(iscoloring);
1677:   PetscMalloc(Nc*info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&g_f);
1678:   PetscMalloc(info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&f);

1680:   /* Seed the input array g_u with coloring information */
1681: 
1682:   VecGetArray(vu,&u);
1683:   (lf)(&Nc,&info,u,g_u,&Nc,f,g_f,&Nc,w,&ierr);
1684:   VecRestoreArray(vu,&u);

1686:   /* stick the values into the matrix */
1687:   /* PetscScalarView(Nc*info.xm*info.ym,g_f,0); */
1688:   MatSetValuesAdifor(J,Nc,g_f);

1690:   /* return space for derivative objects.  */
1691:   PetscFree(g_u);
1692:   PetscFree(g_f);
1693:   PetscFree(f);
1694:   return(0);
1695: }

1699: /*@C
1700:     DAMultiplyByJacobian1WithAD - Applies a Jacobian function supplied by ADIFOR or ADIC
1701:     to a vector on each processor that shares a DA.

1703:    Input Parameters:
1704: +    da - the DA that defines the grid
1705: .    vu - Jacobian is computed at this point (ghosted)
1706: .    v - product is done on this vector (ghosted)
1707: .    fu - output vector = J(vu)*v (not ghosted)
1708: -    w - any user data

1710:     Notes: 
1711:     This routine does NOT do ghost updates on vu and v upon entry.
1712:            
1713:     Automatically calls DAMultiplyByJacobian1WithAdifor() or DAMultiplyByJacobian1WithAdic()
1714:     depending on whether DASetLocalAdicMFFunction() or DASetLocalAdiforMFFunction() was called.

1716:    Level: advanced

1718: .seealso: DAFormFunction1(), DAMultiplyByJacobian1WithAdifor(), DAMultiplyByJacobian1WithAdic()

1720: @*/
1721: PetscErrorCode DAMultiplyByJacobian1WithAD(DA da,Vec u,Vec v,Vec f,void *w)
1722: {

1726:   if (da->adicmf_lf) {
1727: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1728:     DAMultiplyByJacobian1WithAdic(da,u,v,f,w);
1729: #else
1730:     SETERRQ(PETSC_ERR_SUP_SYS,"Requires ADIC to be installed and cannot use complex numbers");
1731: #endif
1732:   } else if (da->adiformf_lf) {
1733:     DAMultiplyByJacobian1WithAdifor(da,u,v,f,w);
1734:   } else {
1735:     SETERRQ(PETSC_ERR_ORDER,"Must call DASetLocalAdiforMFFunction() or DASetLocalAdicMFFunction() before using");
1736:   }
1737:   return(0);
1738: }


1743: /*@C
1744:     DAMultiplyByJacobian1WithAdifor - Applies a ADIFOR provided Jacobian function on each processor that 
1745:         share a DA to a vector

1747:    Input Parameters:
1748: +    da - the DA that defines the grid
1749: .    vu - Jacobian is computed at this point (ghosted)
1750: .    v - product is done on this vector (ghosted)
1751: .    fu - output vector = J(vu)*v (not ghosted)
1752: -    w - any user data

1754:     Notes: Does NOT do ghost updates on vu and v upon entry

1756:    Level: advanced

1758: .seealso: DAFormFunction1()

1760: @*/
1761: PetscErrorCode DAMultiplyByJacobian1WithAdifor(DA da,Vec u,Vec v,Vec f,void *w)
1762: {
1764:   PetscScalar    *au,*av,*af,*awork;
1765:   Vec            work;
1766:   DALocalInfo    info;
1767:   void           (*lf)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*) =
1768:                  (void (*)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*))*da->adiformf_lf;

1771:   DAGetLocalInfo(da,&info);

1773:   DAGetGlobalVector(da,&work);
1774:   VecGetArray(u,&au);
1775:   VecGetArray(v,&av);
1776:   VecGetArray(f,&af);
1777:   VecGetArray(work,&awork);
1778:   (lf)(&info,au,av,awork,af,w,&ierr);
1779:   VecRestoreArray(u,&au);
1780:   VecRestoreArray(v,&av);
1781:   VecRestoreArray(f,&af);
1782:   VecRestoreArray(work,&awork);
1783:   DARestoreGlobalVector(da,&work);

1785:   return(0);
1786: }

1790: /*@C
1791:        DASetInterpolationType - Sets the type of interpolation that will be 
1792:           returned by DAGetInterpolation()

1794:    Collective on DA

1796:    Input Parameter:
1797: +  da - initial distributed array
1798: .  ctype - DA_Q1 and DA_Q0 are currently the only supported forms

1800:    Level: intermediate

1802:    Notes: you should call this on the coarser of the two DAs you pass to DAGetInterpolation()

1804: .keywords:  distributed array, interpolation

1806: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DA, DAInterpolationType
1807: @*/
1808: PetscErrorCode DASetInterpolationType(DA da,DAInterpolationType ctype)
1809: {
1812:   da->interptype = ctype;
1813:   return(0);
1814: }