Actual source code: da2.c

  1: /*$Id: da2.c,v 1.180 2001/09/07 20:12:17 bsmith Exp $*/
  2: 
 3:  #include src/dm/da/daimpl.h

  7: int DAGetOwnershipRange(DA da,int **lx,int **ly,int **lz)
  8: {
 11:   if (lx) *lx = da->lx;
 12:   if (ly) *ly = da->ly;
 13:   if (lz) *lz = da->lz;
 14:   return(0);
 15: }

 19: int DAView_2d(DA da,PetscViewer viewer)
 20: {
 21:   int        rank,ierr;
 22:   PetscTruth isascii,isdraw;

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

 27:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
 28:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);
 29:   if (isascii) {
 30:     PetscViewerASCIISynchronizedPrintf(viewer,"Processor [%d] M %d N %d m %d n %d w %d s %d\n",rank,da->M,
 31:                              da->N,da->m,da->n,da->w,da->s);
 32:     PetscViewerASCIISynchronizedPrintf(viewer,"X range of indices: %d %d, Y range of indices: %d %d\n",da->xs,da->xe,da->ys,da->ye);
 33:     PetscViewerFlush(viewer);
 34:   } else if (isdraw) {
 35:     PetscDraw       draw;
 36:     double     ymin = -1*da->s-1,ymax = da->N+da->s;
 37:     double     xmin = -1*da->s-1,xmax = da->M+da->s;
 38:     double     x,y;
 39:     int        base,*idx;
 40:     char       node[10];
 41:     PetscTruth isnull;
 42: 
 43:     PetscViewerDrawGetDraw(viewer,0,&draw);
 44:     PetscDrawIsNull(draw,&isnull); if (isnull) return(0);
 45:     PetscDrawSetCoordinates(draw,xmin,ymin,xmax,ymax);
 46:     PetscDrawSynchronizedClear(draw);

 48:     /* first processor draw all node lines */
 49:     if (!rank) {
 50:       ymin = 0.0; ymax = da->N - 1;
 51:       for (xmin=0; xmin<da->M; xmin++) {
 52:         PetscDrawLine(draw,xmin,ymin,xmin,ymax,PETSC_DRAW_BLACK);
 53:       }
 54:       xmin = 0.0; xmax = da->M - 1;
 55:       for (ymin=0; ymin<da->N; ymin++) {
 56:         PetscDrawLine(draw,xmin,ymin,xmax,ymin,PETSC_DRAW_BLACK);
 57:       }
 58:     }
 59:     PetscDrawSynchronizedFlush(draw);
 60:     PetscDrawPause(draw);

 62:     /* draw my box */
 63:     ymin = da->ys; ymax = da->ye - 1; xmin = da->xs/da->w;
 64:     xmax =(da->xe-1)/da->w;
 65:     PetscDrawLine(draw,xmin,ymin,xmax,ymin,PETSC_DRAW_RED);
 66:     PetscDrawLine(draw,xmin,ymin,xmin,ymax,PETSC_DRAW_RED);
 67:     PetscDrawLine(draw,xmin,ymax,xmax,ymax,PETSC_DRAW_RED);
 68:     PetscDrawLine(draw,xmax,ymin,xmax,ymax,PETSC_DRAW_RED);

 70:     /* put in numbers */
 71:     base = (da->base)/da->w;
 72:     for (y=ymin; y<=ymax; y++) {
 73:       for (x=xmin; x<=xmax; x++) {
 74:         sprintf(node,"%d",base++);
 75:         PetscDrawString(draw,x,y,PETSC_DRAW_BLACK,node);
 76:       }
 77:     }

 79:     PetscDrawSynchronizedFlush(draw);
 80:     PetscDrawPause(draw);
 81:     /* overlay ghost numbers, useful for error checking */
 82:     /* put in numbers */

 84:     base = 0; idx = da->idx;
 85:     ymin = da->Ys; ymax = da->Ye; xmin = da->Xs; xmax = da->Xe;
 86:     for (y=ymin; y<ymax; y++) {
 87:       for (x=xmin; x<xmax; x++) {
 88:         if ((base % da->w) == 0) {
 89:           sprintf(node,"%d",idx[base]/da->w);
 90:           PetscDrawString(draw,x/da->w,y,PETSC_DRAW_BLUE,node);
 91:         }
 92:         base++;
 93:       }
 94:     }
 95:     PetscDrawSynchronizedFlush(draw);
 96:     PetscDrawPause(draw);
 97:   } else {
 98:     SETERRQ1(1,"Viewer type %s not supported for DA2d",((PetscObject)viewer)->type_name);
 99:   }
100:   return(0);
101: }

103: #if defined(PETSC_HAVE_AMS)
104: /*
105:       This function tells the AMS the layout of the vectors, it is called
106:    in the VecPublish_xx routines.
107: */
108: EXTERN_C_BEGIN
111: int AMSSetFieldBlock_DA(AMS_Memory amem,char *name,Vec vec)
112: {
113:   int        ierr,dof,dim,ends[4],shift = 0,starts[] = {0,0,0,0};
114:   DA         da = 0;
115:   PetscTruth isseq,ismpi;

118:   if (((PetscObject)vec)->amem < 0) return(0); /* return if not published */

120:   PetscObjectQuery((PetscObject)vec,"DA",(PetscObject*)&da);
121:   if (!da) return(0);
122:   DAGetInfo(da,&dim,0,0,0,0,0,0,&dof,0,0,0);
123:   if (dof > 1) {dim++; shift = 1; ends[0] = dof;}

125:   PetscTypeCompare((PetscObject)vec,VECSEQ,&isseq);
126:   PetscTypeCompare((PetscObject)vec,VECMPI,&ismpi);
127:   if (isseq) {
128:     DAGetGhostCorners(da,0,0,0,ends+shift,ends+shift+1,ends+shift+2);
129:     ends[shift]   += starts[shift]-1;
130:     ends[shift+1] += starts[shift+1]-1;
131:     ends[shift+2] += starts[shift+2]-1;
132:     AMS_Memory_set_field_block(amem,name,dim,starts,ends);
133:     if (ierr) {
134:       char *message;
135:       AMS_Explain_error(ierr,&message);
136:       SETERRQ(ierr,message);
137:     }
138:   } else if (ismpi) {
139:     DAGetCorners(da,starts+shift,starts+shift+1,starts+shift+2,
140:                            ends+shift,ends+shift+1,ends+shift+2);
141:     ends[shift]   += starts[shift]-1;
142:     ends[shift+1] += starts[shift+1]-1;
143:     ends[shift+2] += starts[shift+2]-1;
144:     AMS_Memory_set_field_block(amem,name,dim,starts,ends);
145:     if (ierr) {
146:       char *message;
147:       AMS_Explain_error(ierr,&message);
148:       SETERRQ(ierr,message);
149:     }
150:   } else {
151:     SETERRQ1(1,"Wrong vector type %s for this call",((PetscObject)vec)->type_name);
152:   }

154:   return(0);
155: }
156: EXTERN_C_END
157: #endif

161: int DAPublish_Petsc(PetscObject obj)
162: {
163: #if defined(PETSC_HAVE_AMS)
164:   DA          v = (DA) obj;
165:   int         ierr;
166: #endif


170: #if defined(PETSC_HAVE_AMS)
171:   /* if it is already published then return */
172:   if (v->amem >=0) return(0);

174:   PetscObjectPublishBaseBegin(obj);
175:   PetscObjectPublishBaseEnd(obj);
176: #endif

178:   return(0);
179: }


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

188:    Collective on MPI_Comm

190:    Input Parameters:
191: +  comm - MPI communicator
192: .  wrap - type of periodicity should the array have. 
193:          Use one of DA_NONPERIODIC, DA_XPERIODIC, DA_YPERIODIC, or DA_XYPERIODIC.
194: .  stencil_type - stencil type.  Use either DA_STENCIL_BOX or DA_STENCIL_STAR.
195: .  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 
196:             from the command line with -da_grid_x <M> -da_grid_y <N>)
197: .  m,n - corresponding number of processors in each dimension 
198:          (or PETSC_DECIDE to have calculated)
199: .  dof - number of degrees of freedom per node
200: .  s - stencil width
201: -  lx, ly - arrays containing the number of nodes in each cell along
202:            the x and y coordinates, or PETSC_NULL. If non-null, these
203:            must be of length as m and n, and the corresponding
204:            m and n cannot be PETSC_DECIDE. The sum of the lx[] entries
205:            must be M, and the sum of the ly[] entries must be N.

207:    Output Parameter:
208: .  inra - the resulting distributed array object

210:    Options Database Key:
211: +  -da_view - Calls DAView() at the conclusion of DACreate2d()
212: .  -da_grid_x <nx> - number of grid points in x direction, if M < 0
213: .  -da_grid_y <ny> - number of grid points in y direction, if N < 0
214: .  -da_processors_x <nx> - number of processors in x direction
215: -  -da_processors_y <ny> - number of processors in y direction

217:    Level: beginner

219:    Notes:
220:    The stencil type DA_STENCIL_STAR with width 1 corresponds to the 
221:    standard 5-pt stencil, while DA_STENCIL_BOX with width 1 denotes
222:    the standard 9-pt stencil.

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

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

230: .seealso: DADestroy(), DAView(), DACreate1d(), DACreate3d(), DAGlobalToLocalBegin(),
231:           DAGlobalToLocalEnd(), DALocalToGlobal(), DALocalToLocalBegin(), DALocalToLocalEnd(),
232:           DAGetInfo(), DACreateGlobalVector(), DACreateLocalVector(), DACreateNaturalVector(), DALoad(), DAView()

234: @*/
235: int DACreate2d(MPI_Comm comm,DAPeriodicType wrap,DAStencilType stencil_type,
236:                 int M,int N,int m,int n,int dof,int s,int *lx,int *ly,DA *inra)
237: {
238:   int           rank,size,xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,ierr,start,end;
239:   int           up,down,left,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn;
240:   int           xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count;
241:   int           s_x,s_y; /* s proportionalized to w */
242:   int           *flx = 0,*fly = 0;
243:   int           sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0,refine_x = 2, refine_y = 2,tM = M,tN = N;
244:   PetscTruth    flg1,flg2;
245:   DA            da;
246:   Vec           local,global;
247:   VecScatter    ltog,gtol;
248:   IS            to,from;

252:   *inra = 0;
253: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
254:   DMInitializePackage(PETSC_NULL);
255: #endif

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

260:   PetscOptionsBegin(comm,PETSC_NULL,"2d DA Options","DA");
261:     if (M < 0){
262:       tM = -M;
263:       PetscOptionsInt("-da_grid_x","Number of grid points in x direction","DACreate2d",tM,&tM,PETSC_NULL);
264:     }
265:     if (N < 0){
266:       tN = -N;
267:       PetscOptionsInt("-da_grid_y","Number of grid points in y direction","DACreate2d",tN,&tN,PETSC_NULL);
268:     }
269:     PetscOptionsInt("-da_processors_x","Number of processors in x direction","DACreate2d",m,&m,PETSC_NULL);
270:     PetscOptionsInt("-da_processors_y","Number of processors in y direction","DACreate2d",n,&n,PETSC_NULL);
271:     PetscOptionsInt("-da_refine_x","Refinement ratio in x direction","DACreate2d",refine_x,&refine_x,PETSC_NULL);
272:     PetscOptionsInt("-da_refine_y","Refinement ratio in y direction","DACreate2d",refine_y,&refine_y,PETSC_NULL);
273:   PetscOptionsEnd();
274:   M = tM; N = tN;

276:   PetscHeaderCreate(da,_p_DA,struct _DAOps,DA_COOKIE,0,"DA",comm,DADestroy,DAView);
277:   PetscLogObjectCreate(da);
278:   da->bops->publish           = DAPublish_Petsc;
279:   da->ops->createglobalvector = DACreateGlobalVector;
280:   da->ops->getinterpolation   = DAGetInterpolation;
281:   da->ops->getcoloring        = DAGetColoring;
282:   da->ops->getmatrix          = DAGetMatrix;
283:   da->ops->refine             = DARefine;
284:   da->ops->getinjection       = DAGetInjection;
285:   PetscLogObjectMemory(da,sizeof(struct _p_DA));
286:   da->dim        = 2;
287:   da->interptype = DA_Q1;
288:   da->refine_x   = refine_x;
289:   da->refine_y   = refine_y;
290:   PetscMalloc(dof*sizeof(char*),&da->fieldname);
291:   PetscMemzero(da->fieldname,dof*sizeof(char*));

293:   MPI_Comm_size(comm,&size);
294:   MPI_Comm_rank(comm,&rank);

296:   if (m != PETSC_DECIDE) {
297:     if (m < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %d",m);}
298:     else if (m > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %d %d",m,size);}
299:   }
300:   if (n != PETSC_DECIDE) {
301:     if (n < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %d",n);}
302:     else if (n > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %d %d",n,size);}
303:   }

305:   if (m == PETSC_DECIDE || n == PETSC_DECIDE) {
306:     /* try for squarish distribution */
307:     /* This should use MPI_Dims_create instead */
308:     m = (int)(0.5 + sqrt(((double)M)*((double)size)/((double)N)));
309:     if (!m) m = 1;
310:     while (m > 0) {
311:       n = size/m;
312:       if (m*n == size) break;
313:       m--;
314:     }
315:     if (M > N && m < n) {int _m = m; m = n; n = _m;}
316:     if (m*n != size) SETERRQ(PETSC_ERR_PLIB,"Internally Created Bad Partition");
317:   } else if (m*n != size) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition");

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

322:   /*
323:      We should create an MPI Cartesian topology here, with reorder
324:      set to true.  That would create a NEW communicator that we would
325:      need to use for operations on this distributed array 
326:   */
327:   PetscOptionsHasName(PETSC_NULL,"-da_partition_nodes_at_end",&flg2);

329:   /* 
330:      Determine locally owned region 
331:      xs is the first local node number, x is the number of local nodes 
332:   */
333:   if (lx) { /* user sets distribution */
334:     x  = lx[rank % m];
335:     xs = 0;
336:     for (i=0; i<(rank % m); i++) {
337:       xs += lx[i];
338:     }
339:     left = xs;
340:     for (i=(rank % m); i<m; i++) {
341:       left += lx[i];
342:     }
343:     if (left != M) {
344:       SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M: %d %d",left,M);
345:     }
346:   } else if (flg2) {
347:     x = (M + rank%m)/m;
348:     if (m > 1 && x < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column width is too thin for stencil! %d %d",x,s);
349:     if (M/m == x) { xs = (rank % m)*x; }
350:     else          { xs = (rank % m)*(x-1) + (M+(rank % m))%(x*m); }
351:     SETERRQ(PETSC_ERR_SUP,"-da_partition_nodes_at_end not supported");
352:   } else { /* Normal PETSc distribution */
353:     x = M/m + ((M % m) > (rank % m));
354:     if (m > 1 && x < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column width is too thin for stencil! %d %d",x,s);
355:     if ((M % m) > (rank % m)) { xs = (rank % m)*x; }
356:     else                      { xs = (M % m)*(x+1) + ((rank % m)-(M % m))*x; }
357:     PetscMalloc(m*sizeof(int),&lx);
358:     flx = lx;
359:     for (i=0; i<m; i++) {
360:       lx[i] = M/m + ((M % m) > i);
361:     }
362:   }

364:   /* 
365:      Determine locally owned region 
366:      ys is the first local node number, y is the number of local nodes 
367:   */
368:   if (ly) { /* user sets distribution */
369:     y  = ly[rank/m];
370:     ys = 0;
371:     for (i=0; i<(rank/m); i++) {
372:       ys += ly[i];
373:     }
374:     left = ys;
375:     for (i=(rank/m); i<n; i++) {
376:       left += ly[i];
377:     }
378:     if (left != N) {
379:       SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Sum of ly across processors not equal to N: %d %d",left,N);
380:     }
381:   } else if (flg2) {
382:     y = (N + rank/m)/n;
383:     if (n > 1 && y < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row width is too thin for stencil! %d %d",y,s);
384:     if (N/n == y) { ys = (rank/m)*y;  }
385:     else          { ys = (rank/m)*(y-1) + (N+(rank/m))%(y*n); }
386:     SETERRQ(PETSC_ERR_SUP,"-da_partition_nodes_at_end not supported");
387:   } else { /* Normal PETSc distribution */
388:     y = N/n + ((N % n) > (rank/m));
389:     if (n > 1 && y < s) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Row width is too thin for stencil! %d %d",y,s);
390:     if ((N % n) > (rank/m)) { ys = (rank/m)*y; }
391:     else                    { ys = (N % n)*(y+1) + ((rank/m)-(N % n))*y; }
392:     PetscMalloc(n*sizeof(int),&ly);
393:     fly  = ly;
394:     for (i=0; i<n; i++) {
395:       ly[i] = N/n + ((N % n) > i);
396:     }
397:   }

399:   xe = xs + x;
400:   ye = ys + y;

402:   /* determine ghost region */
403:   /* Assume No Periodicity */
404:   if (xs-s > 0) Xs = xs - s; else Xs = 0;
405:   if (ys-s > 0) Ys = ys - s; else Ys = 0;
406:   if (xe+s <= M) Xe = xe + s; else Xe = M;
407:   if (ye+s <= N) Ye = ye + s; else Ye = N;

409:   /* X Periodic */
410:   if (DAXPeriodic(wrap)){
411:     Xs = xs - s;
412:     Xe = xe + s;
413:   }

415:   /* Y Periodic */
416:   if (DAYPeriodic(wrap)){
417:     Ys = ys - s;
418:     Ye = ye + s;
419:   }

421:   /* Resize all X parameters to reflect w */
422:   x   *= dof;
423:   xs  *= dof;
424:   xe  *= dof;
425:   Xs  *= dof;
426:   Xe  *= dof;
427:   s_x = s*dof;
428:   s_y = s;

430:   /* determine starting point of each processor */
431:   nn = x*y;
432:   PetscMalloc((2*size+1)*sizeof(int),&bases);
433:   ldims = (int*)(bases+size+1);
434:   MPI_Allgather(&nn,1,MPI_INT,ldims,1,MPI_INT,comm);
435:   bases[0] = 0;
436:   for (i=1; i<=size; i++) {
437:     bases[i] = ldims[i-1];
438:   }
439:   for (i=1; i<=size; i++) {
440:     bases[i] += bases[i-1];
441:   }

443:   /* allocate the base parallel and sequential vectors */
444:   da->Nlocal = x*y;
445:   VecCreateMPIWithArray(comm,da->Nlocal,PETSC_DECIDE,0,&global);
446:   VecSetBlockSize(global,dof);
447:   da->nlocal = (Xe-Xs)*(Ye-Ys) ;
448:   VecCreateSeqWithArray(PETSC_COMM_SELF,da->nlocal,0,&local);
449:   VecSetBlockSize(local,dof);


452:   /* generate appropriate vector scatters */
453:   /* local to global inserts non-ghost point region into global */
454:   VecGetOwnershipRange(global,&start,&end);
455:   ISCreateStride(comm,x*y,start,1,&to);

457:   left  = xs - Xs; down  = ys - Ys; up    = down + y;
458:   PetscMalloc(x*(up - down)*sizeof(int),&idx);
459:   count = 0;
460:   for (i=down; i<up; i++) {
461:     for (j=0; j<x; j++) {
462:       idx[count++] = left + i*(Xe-Xs) + j;
463:     }
464:   }
465:   ISCreateGeneral(comm,count,idx,&from);
466:   PetscFree(idx);

468:   VecScatterCreate(local,from,global,to,&ltog);
469:   PetscLogObjectParent(da,to);
470:   PetscLogObjectParent(da,from);
471:   PetscLogObjectParent(da,ltog);
472:   ISDestroy(from);
473:   ISDestroy(to);

475:   /* global to local must include ghost points */
476:   if (stencil_type == DA_STENCIL_BOX) {
477:     ISCreateStride(comm,(Xe-Xs)*(Ye-Ys),0,1,&to);
478:   } else {
479:     /* must drop into cross shape region */
480:     /*       ---------|
481:             |  top    |
482:          |---         ---|
483:          |   middle      |
484:          |               |
485:          ----         ----
486:             | bottom  |
487:             -----------
488:         Xs xs        xe  Xe */
489:     /* bottom */
490:     left  = xs - Xs; down = ys - Ys; up    = down + y;
491:     count = down*(xe-xs) + (up-down)*(Xe-Xs) + (Ye-Ys-up)*(xe-xs);
492:     PetscMalloc(count*sizeof(int),&idx);
493:     count = 0;
494:     for (i=0; i<down; i++) {
495:       for (j=0; j<xe-xs; j++) {
496:         idx[count++] = left + i*(Xe-Xs) + j;
497:       }
498:     }
499:     /* middle */
500:     for (i=down; i<up; i++) {
501:       for (j=0; j<Xe-Xs; j++) {
502:         idx[count++] = i*(Xe-Xs) + j;
503:       }
504:     }
505:     /* top */
506:     for (i=up; i<Ye-Ys; i++) {
507:       for (j=0; j<xe-xs; j++) {
508:         idx[count++] = left + i*(Xe-Xs) + j;
509:       }
510:     }
511:     ISCreateGeneral(comm,count,idx,&to);
512:     PetscFree(idx);
513:   }


516:   /* determine who lies on each side of us stored in    n6 n7 n8
517:                                                         n3    n5
518:                                                         n0 n1 n2
519:   */

521:   /* Assume the Non-Periodic Case */
522:   n1 = rank - m;
523:   if (rank % m) {
524:     n0 = n1 - 1;
525:   } else {
526:     n0 = -1;
527:   }
528:   if ((rank+1) % m) {
529:     n2 = n1 + 1;
530:     n5 = rank + 1;
531:     n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
532:   } else {
533:     n2 = -1; n5 = -1; n8 = -1;
534:   }
535:   if (rank % m) {
536:     n3 = rank - 1;
537:     n6 = n3 + m; if (n6 >= m*n) n6 = -1;
538:   } else {
539:     n3 = -1; n6 = -1;
540:   }
541:   n7 = rank + m; if (n7 >= m*n) n7 = -1;


544:   /* Modify for Periodic Cases */
545:   if (wrap == DA_YPERIODIC) {  /* Handle Top and Bottom Sides */
546:     if (n1 < 0) n1 = rank + m * (n-1);
547:     if (n7 < 0) n7 = rank - m * (n-1);
548:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
549:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
550:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
551:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
552:   } else if (wrap == DA_XPERIODIC) { /* Handle Left and Right Sides */
553:     if (n3 < 0) n3 = rank + (m-1);
554:     if (n5 < 0) n5 = rank - (m-1);
555:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
556:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
557:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
558:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
559:   } else if (wrap == DA_XYPERIODIC) {

561:     /* Handle all four corners */
562:     if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
563:     if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
564:     if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
565:     if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;

567:     /* Handle Top and Bottom Sides */
568:     if (n1 < 0) n1 = rank + m * (n-1);
569:     if (n7 < 0) n7 = rank - m * (n-1);
570:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
571:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
572:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
573:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;

575:     /* Handle Left and Right Sides */
576:     if (n3 < 0) n3 = rank + (m-1);
577:     if (n5 < 0) n5 = rank - (m-1);
578:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
579:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
580:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
581:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
582:   }

584:   if (stencil_type == DA_STENCIL_STAR) {
585:     /* save corner processor numbers */
586:     sn0 = n0; sn2 = n2; sn6 = n6; sn8 = n8;
587:     n0 = n2 = n6 = n8 = -1;
588:   }

590:   PetscMalloc((x+2*s_x)*(y+2*s_y)*sizeof(int),&idx);
591:   PetscLogObjectMemory(da,(x+2*s_x)*(y+2*s_y)*sizeof(int));
592:   nn = 0;

594:   xbase = bases[rank];
595:   for (i=1; i<=s_y; i++) {
596:     if (n0 >= 0) { /* left below */
597:       x_t = lx[n0 % m]*dof;
598:       y_t = ly[(n0/m)];
599:       s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
600:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
601:     }
602:     if (n1 >= 0) { /* directly below */
603:       x_t = x;
604:       y_t = ly[(n1/m)];
605:       s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
606:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
607:     }
608:     if (n2 >= 0) { /* right below */
609:       x_t = lx[n2 % m]*dof;
610:       y_t = ly[(n2/m)];
611:       s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
612:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
613:     }
614:   }

616:   for (i=0; i<y; i++) {
617:     if (n3 >= 0) { /* directly left */
618:       x_t = lx[n3 % m]*dof;
619:       /* y_t = y; */
620:       s_t = bases[n3] + (i+1)*x_t - s_x;
621:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
622:     }

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

626:     if (n5 >= 0) { /* directly right */
627:       x_t = lx[n5 % m]*dof;
628:       /* y_t = y; */
629:       s_t = bases[n5] + (i)*x_t;
630:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
631:     }
632:   }

634:   for (i=1; i<=s_y; i++) {
635:     if (n6 >= 0) { /* left above */
636:       x_t = lx[n6 % m]*dof;
637:       /* y_t = ly[(n6/m)]; */
638:       s_t = bases[n6] + (i)*x_t - s_x;
639:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
640:     }
641:     if (n7 >= 0) { /* directly above */
642:       x_t = x;
643:       /* y_t = ly[(n7/m)]; */
644:       s_t = bases[n7] + (i-1)*x_t;
645:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
646:     }
647:     if (n8 >= 0) { /* right above */
648:       x_t = lx[n8 % m]*dof;
649:       /* y_t = ly[(n8/m)]; */
650:       s_t = bases[n8] + (i-1)*x_t;
651:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
652:     }
653:   }

655:   base = bases[rank];
656:   ISCreateGeneral(comm,nn,idx,&from);
657:   VecScatterCreate(global,from,local,to,&gtol);
658:   PetscLogObjectParent(da,to);
659:   PetscLogObjectParent(da,from);
660:   PetscLogObjectParent(da,gtol);
661:   ISDestroy(to);
662:   ISDestroy(from);

664:   if (stencil_type == DA_STENCIL_STAR) {
665:     /*
666:         Recompute the local to global mappings, this time keeping the 
667:       information about the cross corner processor numbers.
668:     */
669:     n0 = sn0; n2 = sn2; n6 = sn6; n8 = sn8;
670:     nn = 0;
671:     xbase = bases[rank];
672:     for (i=1; i<=s_y; i++) {
673:       if (n0 >= 0) { /* left below */
674:         x_t = lx[n0 % m]*dof;
675:         y_t = ly[(n0/m)];
676:         s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
677:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
678:       }
679:       if (n1 >= 0) { /* directly below */
680:         x_t = x;
681:         y_t = ly[(n1/m)];
682:         s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
683:         for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
684:       }
685:       if (n2 >= 0) { /* right below */
686:         x_t = lx[n2 % m]*dof;
687:         y_t = ly[(n2/m)];
688:         s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
689:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
690:       }
691:     }

693:     for (i=0; i<y; i++) {
694:       if (n3 >= 0) { /* directly left */
695:         x_t = lx[n3 % m]*dof;
696:         /* y_t = y; */
697:         s_t = bases[n3] + (i+1)*x_t - s_x;
698:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
699:       }

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

703:       if (n5 >= 0) { /* directly right */
704:         x_t = lx[n5 % m]*dof;
705:         /* y_t = y; */
706:         s_t = bases[n5] + (i)*x_t;
707:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
708:       }
709:     }

711:     for (i=1; i<=s_y; i++) {
712:       if (n6 >= 0) { /* left above */
713:         x_t = lx[n6 % m]*dof;
714:         /* y_t = ly[(n6/m)]; */
715:         s_t = bases[n6] + (i)*x_t - s_x;
716:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
717:       }
718:       if (n7 >= 0) { /* directly above */
719:         x_t = x;
720:         /* y_t = ly[(n7/m)]; */
721:         s_t = bases[n7] + (i-1)*x_t;
722:         for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
723:       }
724:       if (n8 >= 0) { /* right above */
725:         x_t = lx[n8 % m]*dof;
726:         /* y_t = ly[(n8/m)]; */
727:         s_t = bases[n8] + (i-1)*x_t;
728:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
729:       }
730:     }
731:   }
732:   PetscFree(bases);

734:   da->M  = M;  da->N  = N;  da->m  = m;  da->n  = n;  da->w = dof;  da->s = s;
735:   da->xs = xs; da->xe = xe; da->ys = ys; da->ye = ye; da->zs = 0; da->ze = 1;
736:   da->Xs = Xs; da->Xe = Xe; da->Ys = Ys; da->Ye = Ye; da->Zs = 0; da->Ze = 1;
737:   da->P  = 1;  da->p  = 1;

739:   VecDestroy(local);
740:   VecDestroy(global);

742:   da->gtol         = gtol;
743:   da->ltog         = ltog;
744:   da->idx          = idx;
745:   da->Nl           = nn;
746:   da->base         = base;
747:   da->wrap         = wrap;
748:   da->ops->view    = DAView_2d;
749:   da->stencil_type = stencil_type;

751:   /* 
752:      Set the local to global ordering in the global vector, this allows use
753:      of VecSetValuesLocal().
754:   */
755:   ISLocalToGlobalMappingCreateNC(comm,nn,idx,&da->ltogmap);
756:   ISLocalToGlobalMappingBlock(da->ltogmap,da->w,&da->ltogmapb);
757:   PetscLogObjectParent(da,da->ltogmap);

759:   *inra = da;

761:   da->ltol = PETSC_NULL;
762:   da->ao   = PETSC_NULL;


765:   if (!flx) {
766:     PetscMalloc(m*sizeof(int),&flx);
767:     PetscMemcpy(flx,lx,m*sizeof(int));
768:   }
769:   if (!fly) {
770:     PetscMalloc(n*sizeof(int),&fly);
771:     PetscMemcpy(fly,ly,n*sizeof(int));
772:   }
773:   da->lx = flx;
774:   da->ly = fly;

776:   PetscOptionsHasName(PETSC_NULL,"-da_view",&flg1);
777:   if (flg1) {DAView(da,PETSC_VIEWER_STDOUT_(da->comm));}
778:   PetscOptionsHasName(PETSC_NULL,"-da_view_draw",&flg1);
779:   if (flg1) {DAView(da,PETSC_VIEWER_DRAW_(da->comm));}
780:   PetscOptionsHasName(PETSC_NULL,"-help",&flg1);
781:   if (flg1) {DAPrintHelp(da);}

783:   PetscPublishAll(da);
784:   return(0);
785: }

789: /*@
790:    DAPrintHelp - Prints command line options for DA.

792:    Collective on DA

794:    Input Parameters:
795: .  da - the distributed array

797:    Level: intermediate

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

801: .keywords: DA, help

803: @*/
804: int DAPrintHelp(DA da)
805: {
806:   static PetscTruth called = PETSC_FALSE;
807:   MPI_Comm          comm;
808:   int               ierr;


813:   comm = da->comm;
814:   if (!called) {
815:     (*PetscHelpPrintf)(comm,"General Distributed Array (DA) options:\n");
816:     (*PetscHelpPrintf)(comm,"  -da_view: print DA distribution to screen\n");
817:     (*PetscHelpPrintf)(comm,"  -da_view_draw: display DA in window\n");
818:     called = PETSC_TRUE;
819:   }
820:   return(0);
821: }

825: /*@C
826:    DARefine - Creates a new distributed array that is a refinement of a given
827:    distributed array.

829:    Collective on DA

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

836:    Output Parameter:
837: .  daref - refined distributed array

839:    Level: advanced

841:    Note:
842:    Currently, refinement consists of just doubling the number of grid spaces
843:    in each dimension of the DA.

845: .keywords:  distributed array, refine

847: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy()
848: @*/
849: int DARefine(DA da,MPI_Comm comm,DA *daref)
850: {
851:   int M,N,P,ierr;
852:   DA  da2;


858:   if (DAXPeriodic(da->wrap) || da->interptype == DA_Q0){
859:     M = da->refine_x*da->M;
860:   } else {
861:     M = 1 + da->refine_x*(da->M - 1);
862:   }
863:   if (DAYPeriodic(da->wrap) || da->interptype == DA_Q0){
864:     N = da->refine_y*da->N;
865:   } else {
866:     N = 1 + da->refine_y*(da->N - 1);
867:   }
868:   if (DAZPeriodic(da->wrap) || da->interptype == DA_Q0){
869:     P = da->refine_z*da->P;
870:   } else {
871:     P = 1 + da->refine_z*(da->P - 1);
872:   }
873:   if (da->dim == 1) {
874:     DACreate1d(da->comm,da->wrap,M,da->w,da->s,PETSC_NULL,&da2);
875:   } else if (da->dim == 2) {
876:     DACreate2d(da->comm,da->wrap,da->stencil_type,M,N,da->m,da->n,da->w,da->s,PETSC_NULL,PETSC_NULL,&da2);
877:   } else if (da->dim == 3) {
878:     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);
879:   }
880:   /* allow overloaded (user replaced) operations to be inherited by refinement clones */
881:   da2->ops->getmatrix        = da->ops->getmatrix;
882:   da2->ops->getinterpolation = da->ops->getinterpolation;
883:   da2->ops->getcoloring      = da->ops->getcoloring;
884: 
885:   /* copy fill information if given */
886:   if (da->dfill) {
887:     PetscMalloc((da->dfill[da->w]+da->w+1)*sizeof(int),&da2->dfill);
888:     PetscMemcpy(da2->dfill,da->dfill,(da->dfill[da->w]+da->w+1)*sizeof(int));
889:   }
890:   if (da->ofill) {
891:     PetscMalloc((da->ofill[da->w]+da->w+1)*sizeof(int),&da2->ofill);
892:     PetscMemcpy(da2->ofill,da->ofill,(da->ofill[da->w]+da->w+1)*sizeof(int));
893:   }
894:   *daref = da2;
895:   return(0);
896: }

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

901:     Collective on DA

903:   Input Parameters:
904: +    da - the DA object
905: -    f - the function that allocates the matrix for that specific DA

907:   Level: developer

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

912: .seealso: DAGetMatrix(), DASetBlockFills()
913: @*/
914: int DASetGetMatrix(DA da,int (*f)(DA,const MatType,Mat*))
915: {
917:   da->ops->getmatrix = f;
918:   return(0);
919: }

921: /*
922:       M is number of grid points 
923:       m is number of processors

925: */
928: int DASplitComm2d(MPI_Comm comm,int M,int N,int sw,MPI_Comm *outcomm)
929: {
930:   int ierr,m,n = 0,csize,size,rank,x = 0,y = 0;

933:   MPI_Comm_size(comm,&size);
934:   MPI_Comm_rank(comm,&rank);

936:   csize = 4*size;
937:   do {
938:     if (csize % 4) SETERRQ4(1,"Cannot split communicator of size %d tried %d %d %d",size,csize,x,y);
939:     csize   = csize/4;
940: 
941:     m = (int)(0.5 + sqrt(((double)M)*((double)csize)/((double)N)));
942:     if (!m) m = 1;
943:     while (m > 0) {
944:       n = csize/m;
945:       if (m*n == csize) break;
946:       m--;
947:     }
948:     if (M > N && m < n) {int _m = m; m = n; n = _m;}

950:     x = M/m + ((M % m) > ((csize-1) % m));
951:     y = (N + (csize-1)/m)/n;
952:   } while ((x < 4 || y < 4) && csize > 1);
953:   if (size != csize) {
954:     MPI_Group entire_group,sub_group;
955:     int       i,*groupies;

957:     MPI_Comm_group(comm,&entire_group);
958:     PetscMalloc(csize*sizeof(int),&groupies);
959:     for (i=0; i<csize; i++) {
960:       groupies[i] = (rank/csize)*csize + i;
961:     }
962:     MPI_Group_incl(entire_group,csize,groupies,&sub_group);
963:     PetscFree(groupies);
964:     MPI_Comm_create(comm,sub_group,outcomm);
965:     MPI_Group_free(&entire_group);
966:     MPI_Group_free(&sub_group);
967:     PetscLogInfo(0,"Creating redundant coarse problems of size %d\n",csize);
968:   } else {
969:     *outcomm = comm;
970:   }
971:   return(0);
972: }

976: /*@C
977:        DASetLocalFunction - Caches in a DA a local function. 

979:    Collective on DA

981:    Input Parameter:
982: +  da - initial distributed array
983: -  lf - the local function

985:    Level: intermediate

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

989: .keywords:  distributed array, refine

991: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunctioni()
992: @*/
993: int DASetLocalFunction(DA da,DALocalFunction1 lf)
994: {
997:   da->lf    = lf;
998:   return(0);
999: }

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

1006:    Collective on DA

1008:    Input Parameter:
1009: +  da - initial distributed array
1010: -  lfi - the local function

1012:    Level: intermediate

1014: .keywords:  distributed array, refine

1016: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1017: @*/
1018: int DASetLocalFunctioni(DA da,int (*lfi)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*))
1019: {
1022:   da->lfi = lfi;
1023:   return(0);
1024: }


1029: int DASetLocalAdicFunction_Private(DA da,DALocalFunction1 ad_lf)
1030: {
1033:   da->adic_lf = ad_lf;
1034:   return(0);
1035: }

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

1040:    Collective on DA

1042:    Synopsis:
1043:    int int DASetLocalAdicFunctioni(DA da,int (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1044:    
1045:    Input Parameter:
1046: +  da - initial distributed array
1047: -  ad_lfi - the local function as computed by ADIC/ADIFOR

1049:    Level: intermediate

1051: .keywords:  distributed array, refine

1053: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1054:           DASetLocalJacobian(), DASetLocalFunctioni()
1055: M*/

1059: int DASetLocalAdicFunctioni_Private(DA da,int (*ad_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1060: {
1063:   da->adic_lfi = ad_lfi;
1064:   return(0);
1065: }

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

1070:    Collective on DA

1072:    Synopsis:
1073:    int int DASetLocalAdicFunctioni(DA da,int (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1074:    
1075:    Input Parameter:
1076: +  da - initial distributed array
1077: -  admf_lfi - the local matrix-free function as computed by ADIC/ADIFOR

1079:    Level: intermediate

1081: .keywords:  distributed array, refine

1083: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1084:           DASetLocalJacobian(), DASetLocalFunctioni()
1085: M*/

1089: int DASetLocalAdicMFFunctioni_Private(DA da,int (*admf_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1090: {
1093:   da->adicmf_lfi = admf_lfi;
1094:   return(0);
1095: }

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

1100:    Collective on DA

1102:    Synopsis:
1103:    int int DASetLocalAdicMFFunction(DA da,DALocalFunction1 ad_lf)
1104:    
1105:    Input Parameter:
1106: +  da - initial distributed array
1107: -  ad_lf - the local function as computed by ADIC/ADIFOR

1109:    Level: intermediate

1111: .keywords:  distributed array, refine

1113: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1114:           DASetLocalJacobian()
1115: M*/

1119: int DASetLocalAdicMFFunction_Private(DA da,DALocalFunction1 ad_lf)
1120: {
1123:   da->adicmf_lf = ad_lf;
1124:   return(0);
1125: }

1127: /*@C
1128:        DASetLocalJacobian - Caches in a DA a local Jacobian

1130:    Collective on DA

1132:    
1133:    Input Parameter:
1134: +  da - initial distributed array
1135: -  lj - the local Jacobian

1137:    Level: intermediate

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

1141: .keywords:  distributed array, refine

1143: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1144: @*/
1147: int DASetLocalJacobian(DA da,DALocalFunction1 lj)
1148: {
1151:   da->lj    = lj;
1152:   return(0);
1153: }

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

1160:    Collective on DA

1162:    Input Parameter:
1163: .  da - initial distributed array

1165:    Output Parameters:
1166: .  lf - the local function

1168:    Level: intermediate

1170: .keywords:  distributed array, refine

1172: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DASetLocalFunction()
1173: @*/
1174: int DAGetLocalFunction(DA da,DALocalFunction1 *lf)
1175: {
1178:   if (lf)       *lf = da->lf;
1179:   return(0);
1180: }

1184: /*@
1185:     DAFormFunction1 - Evaluates a user provided function on each processor that 
1186:         share a DA

1188:    Input Parameters:
1189: +    da - the DA that defines the grid
1190: .    vu - input vector
1191: .    vfu - output vector 
1192: -    w - any user data

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

1196:     Level: advanced

1198: .seealso: DAComputeJacobian1WithAdic()

1200: @*/
1201: int DAFormFunction1(DA da,Vec vu,Vec vfu,void *w)
1202: {
1203:   int         ierr;
1204:   void        *u,*fu;
1205:   DALocalInfo info;
1206: 

1209:   DAGetLocalInfo(da,&info);
1210:   DAVecGetArray(da,vu,&u);
1211:   DAVecGetArray(da,vfu,&fu);

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

1215:   DAVecRestoreArray(da,vu,&u);
1216:   DAVecRestoreArray(da,vfu,&fu);
1217:   return(0);
1218: }

1222: int DAFormFunctioniTest1(DA da,void *w)
1223: {
1224:   Vec         vu,fu,fui;
1225:   int         ierr,i,n;
1226:   PetscScalar *ui,mone = -1.0;
1227:   PetscRandom rnd;
1228:   PetscReal   norm;

1231:   DAGetLocalVector(da,&vu);
1232:   PetscRandomCreate(PETSC_COMM_SELF,RANDOM_DEFAULT,&rnd);
1233:   VecSetRandom(rnd,vu);
1234:   PetscRandomDestroy(rnd);

1236:   DAGetGlobalVector(da,&fu);
1237:   DAGetGlobalVector(da,&fui);
1238: 
1239:   DAFormFunction1(da,vu,fu,w);

1241:   VecGetArray(fui,&ui);
1242:   VecGetLocalSize(fui,&n);
1243:   for (i=0; i<n; i++) {
1244:     DAFormFunctioni1(da,i,vu,ui+i,w);
1245:   }
1246:   VecRestoreArray(fui,&ui);

1248:   VecAXPY(&mone,fu,fui);
1249:   VecNorm(fui,NORM_2,&norm);
1250:   PetscPrintf(da->comm,"Norm of difference in vectors %g\n",norm);
1251:   VecView(fu,0);
1252:   VecView(fui,0);

1254:   DARestoreLocalVector(da,&vu);
1255:   DARestoreGlobalVector(da,&fu);
1256:   DARestoreGlobalVector(da,&fui);
1257:   return(0);
1258: }

1262: /*@
1263:     DAFormFunctioni1 - Evaluates a user provided function

1265:    Input Parameters:
1266: +    da - the DA that defines the grid
1267: .    i - the component of the function we wish to compute (must be local)
1268: .    vu - input vector
1269: .    vfu - output value
1270: -    w - any user data

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

1274:     Level: advanced

1276: .seealso: DAComputeJacobian1WithAdic()

1278: @*/
1279: int DAFormFunctioni1(DA da,int i,Vec vu,PetscScalar *vfu,void *w)
1280: {
1281:   int         ierr;
1282:   void        *u;
1283:   DALocalInfo info;
1284:   MatStencil  stencil;
1285: 

1288:   DAGetLocalInfo(da,&info);
1289:   DAVecGetArray(da,vu,&u);

1291:   /* figure out stencil value from i */
1292:   stencil.c = i % info.dof;
1293:   stencil.i = (i % (info.xm*info.dof))/info.dof;
1294:   stencil.j = (i % (info.xm*info.ym*info.dof))/(info.xm*info.dof);
1295:   stencil.k = i/(info.xm*info.ym*info.dof);

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

1299:   DAVecRestoreArray(da,vu,&u);
1300:   return(0);
1301: }

1303: #if defined(new)
1306: /*
1307:   DAGetDiagonal_MFFD - Gets the diagonal for a matrix free matrix where local
1308:     function lives on a DA

1310:         y ~= (F(u + ha) - F(u))/h, 
1311:   where F = nonlinear function, as set by SNESSetFunction()
1312:         u = current iterate
1313:         h = difference interval
1314: */
1315: int DAGetDiagonal_MFFD(DA da,Vec U,Vec a)
1316: {
1317:   PetscScalar  h,*aa,*ww,v;
1318:   PetscReal    epsilon = PETSC_SQRT_MACHINE_EPSILON,umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
1319:   int          ierr,gI,nI;
1320:   MatStencil   stencil;
1321:   DALocalInfo  info;
1322: 
1324:   (*ctx->func)(0,U,a,ctx->funcctx);
1325:   (*ctx->funcisetbase)(U,ctx->funcctx);

1327:   VecGetArray(U,&ww);
1328:   VecGetArray(a,&aa);
1329: 
1330:   nI = 0;
1331:     h  = ww[gI];
1332:     if (h == 0.0) h = 1.0;
1333: #if !defined(PETSC_USE_COMPLEX)
1334:     if (h < umin && h >= 0.0)      h = umin;
1335:     else if (h < 0.0 && h > -umin) h = -umin;
1336: #else
1337:     if (PetscAbsScalar(h) < umin && PetscRealPart(h) >= 0.0)     h = umin;
1338:     else if (PetscRealPart(h) < 0.0 && PetscAbsScalar(h) < umin) h = -umin;
1339: #endif
1340:     h     *= epsilon;
1341: 
1342:     ww[gI += h;
1343:     (*ctx->funci)(i,w,&v,ctx->funcctx);
1344:     aa[nI]  = (v - aa[nI])/h;
1345:     ww[gI] -= h;
1346:     nI++;
1347:   }
1348:   VecRestoreArray(U,&ww);
1349:   VecRestoreArray(a,&aa);
1350:   return(0);
1351: }
1352: #endif

1354: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1355: EXTERN_C_BEGIN
1356: #include "adic/ad_utils.h"
1357: EXTERN_C_END

1361: /*@
1362:     DAComputeJacobian1WithAdic - Evaluates a adiC provided Jacobian function on each processor that 
1363:         share a DA

1365:    Input Parameters:
1366: +    da - the DA that defines the grid
1367: .    vu - input vector (ghosted)
1368: .    J - output matrix
1369: -    w - any user data

1371:    Level: advanced

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

1375: .seealso: DAFormFunction1()

1377: @*/
1378: int DAComputeJacobian1WithAdic(DA da,Vec vu,Mat J,void *w)
1379: {
1380:   int         ierr,gtdof,tdof;
1381:   PetscScalar *ustart;
1382:   DALocalInfo info;
1383:   void        *ad_u,*ad_f,*ad_ustart,*ad_fstart;
1384:   ISColoring  iscoloring;

1387:   DAGetLocalInfo(da,&info);

1389:   PetscADResetIndep();

1391:   /* get space for derivative objects.  */
1392:   DAGetAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1393:   DAGetAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1394:   VecGetArray(vu,&ustart);
1395:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);

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

1399:   VecRestoreArray(vu,&ustart);
1400:   ISColoringDestroy(iscoloring);
1401:   PetscADIncrementTotalGradSize(iscoloring->n);
1402:   PetscADSetIndepDone();

1404:   DALogEventBegin(DA_LocalADFunction,0,0,0,0);
1405:   (*da->adic_lf)(&info,ad_u,ad_f,w);
1406:   DALogEventEnd(DA_LocalADFunction,0,0,0,0);

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

1411:   /* return space for derivative objects.  */
1412:   DARestoreAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1413:   DARestoreAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1414:   return(0);
1415: }

1419: /*@C
1420:     DAMultiplyByJacobian1WithAdic - Applies an ADIC-provided Jacobian function to a vector on 
1421:     each processor that shares a DA.

1423:     Input Parameters:
1424: +   da - the DA that defines the grid
1425: .   vu - Jacobian is computed at this point (ghosted)
1426: .   v - product is done on this vector (ghosted)
1427: .   fu - output vector = J(vu)*v (not ghosted)
1428: -   w - any user data

1430:     Notes: 
1431:     This routine does NOT do ghost updates on vu upon entry.

1433:    Level: advanced

1435: .seealso: DAFormFunction1()

1437: @*/
1438: int DAMultiplyByJacobian1WithAdic(DA da,Vec vu,Vec v,Vec f,void *w)
1439: {
1440:   int         ierr,i,gtdof,tdof;
1441:   PetscScalar *avu,*av,*af,*ad_vustart,*ad_fstart;
1442:   DALocalInfo info;
1443:   void        *ad_vu,*ad_f;

1446:   DAGetLocalInfo(da,&info);

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

1452:   /* copy input vector into derivative object */
1453:   VecGetArray(vu,&avu);
1454:   VecGetArray(v,&av);
1455:   for (i=0; i<gtdof; i++) {
1456:     ad_vustart[2*i]   = avu[i];
1457:     ad_vustart[2*i+1] = av[i];
1458:   }
1459:   VecRestoreArray(vu,&avu);
1460:   VecRestoreArray(v,&av);

1462:   PetscADResetIndep();
1463:   PetscADIncrementTotalGradSize(1);
1464:   PetscADSetIndepDone();

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

1468:   /* stick the values into the vector */
1469:   VecGetArray(f,&af);
1470:   for (i=0; i<tdof; i++) {
1471:     af[i] = ad_fstart[2*i+1];
1472:   }
1473:   VecRestoreArray(f,&af);

1475:   /* return space for derivative objects.  */
1476:   DARestoreAdicMFArray(da,PETSC_TRUE,(void **)&ad_vu,(void**)&ad_vustart,&gtdof);
1477:   DARestoreAdicMFArray(da,PETSC_FALSE,(void **)&ad_f,(void**)&ad_fstart,&tdof);
1478:   return(0);
1479: }


1482: #else

1486: int DAComputeJacobian1WithAdic(DA da,Vec vu,Mat J,void *w)
1487: {
1489:   SETERRQ(1,"Must compile with bmake/PETSC_ARCH/packages flag PETSC_HAVE_ADIC for this routine");
1490: }

1494: int DAMultiplyByJacobian1WithAdic(DA da,Vec vu,Vec v,Vec f,void *w)
1495: {
1497:   SETERRQ(1,"Must compile with bmake/PETSC_ARCH/packages flag PETSC_HAVE_ADIC for this routine");
1498: }

1500: #endif

1504: /*@
1505:     DAComputeJacobian1 - Evaluates a local Jacobian function on each processor that 
1506:         share a DA

1508:    Input Parameters:
1509: +    da - the DA that defines the grid
1510: .    vu - input vector (ghosted)
1511: .    J - output matrix
1512: -    w - any user data

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

1516:     Level: advanced

1518: .seealso: DAFormFunction1()

1520: @*/
1521: int DAComputeJacobian1(DA da,Vec vu,Mat J,void *w)
1522: {
1523:   int         ierr;
1524:   void        *u;
1525:   DALocalInfo info;

1528:   DAGetLocalInfo(da,&info);
1529:   DAVecGetArray(da,vu,&u);
1530:   (*da->lj)(&info,u,J,w);
1531:   DAVecRestoreArray(da,vu,&u);
1532:   return(0);
1533: }


1538: /*
1539:     DAComputeJacobian1WithAdifor - Evaluates a ADIFOR provided Jacobian local function on each processor that 
1540:         share a DA

1542:    Input Parameters:
1543: +    da - the DA that defines the grid
1544: .    vu - input vector (ghosted)
1545: .    J - output matrix
1546: -    w - any user data

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

1550: .seealso: DAFormFunction1()

1552: */
1553: int DAComputeJacobian1WithAdifor(DA da,Vec vu,Mat J,void *w)
1554: {
1555:   int             i,ierr,Nc,N;
1556:   ISColoringValue *color;
1557:   DALocalInfo     info;
1558:   PetscScalar     *u,*g_u,*g_f,*f,*p_u;
1559:   ISColoring      iscoloring;
1560:   void            (*lf)(int *,DALocalInfo*,PetscScalar*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,void*,int*) =
1561:                   (void (*)(int *,DALocalInfo*,PetscScalar*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,void*,int*))*da->adifor_lf;

1564:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);
1565:   Nc   = iscoloring->n;
1566:   DAGetLocalInfo(da,&info);
1567:   N    = info.gxm*info.gym*info.gzm*info.dof;

1569:   /* get space for derivative objects.  */
1570:   PetscMalloc(Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar),&g_u);
1571:   PetscMemzero(g_u,Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar));
1572:   p_u   = g_u;
1573:   color = iscoloring->colors;
1574:   for (i=0; i<N; i++) {
1575:     p_u[*color++] = 1.0;
1576:     p_u          += Nc;
1577:   }
1578:   ISColoringDestroy(iscoloring);
1579:   PetscMalloc(Nc*info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&g_f);
1580:   PetscMalloc(info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&f);

1582:   /* Seed the input array g_u with coloring information */
1583: 
1584:   VecGetArray(vu,&u);
1585:   (lf)(&Nc,&info,u,g_u,&Nc,f,g_f,&Nc,w,&ierr);
1586:   VecRestoreArray(vu,&u);

1588:   /* stick the values into the matrix */
1589:   /* PetscScalarView(Nc*info.xm*info.ym,g_f,0); */
1590:   MatSetValuesAdifor(J,Nc,g_f);

1592:   /* return space for derivative objects.  */
1593:   PetscFree(g_u);
1594:   PetscFree(g_f);
1595:   PetscFree(f);
1596:   return(0);
1597: }

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

1605:    Input Parameters:
1606: +    da - the DA that defines the grid
1607: .    vu - Jacobian is computed at this point (ghosted)
1608: .    v - product is done on this vector (ghosted)
1609: .    fu - output vector = J(vu)*v (not ghosted)
1610: -    w - any user data

1612:     Notes: 
1613:     This routine does NOT do ghost updates on vu and v upon entry.
1614:            
1615:     Automatically calls DAMultiplyByJacobian1WithAdifor() or DAMultiplyByJacobian1WithAdic()
1616:     depending on whether DASetLocalAdicMFFunction() or DASetLocalAdiforMFFunction() was called.

1618:    Level: advanced

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

1622: @*/
1623: int DAMultiplyByJacobian1WithAD(DA da,Vec u,Vec v,Vec f,void *w)
1624: {
1625:   int         ierr;

1628:   if (da->adicmf_lf) {
1629: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1630:     DAMultiplyByJacobian1WithAdic(da,u,v,f,w);
1631: #else
1632:     SETERRQ(1,"Requires ADIC to be installed and cannot use complex numbers");
1633: #endif
1634:   } else if (da->adiformf_lf) {
1635:     DAMultiplyByJacobian1WithAdifor(da,u,v,f,w);
1636:   } else {
1637:     SETERRQ(1,"Must call DASetLocalAdiforMFFunction() or DASetLocalAdicMFFunction() before using");
1638:   }
1639:   return(0);
1640: }


1645: /*@C
1646:     DAMultiplyByJacobian1WithAdifor - Applies a ADIFOR provided Jacobian function on each processor that 
1647:         share a DA to a vector

1649:    Input Parameters:
1650: +    da - the DA that defines the grid
1651: .    vu - Jacobian is computed at this point (ghosted)
1652: .    v - product is done on this vector (ghosted)
1653: .    fu - output vector = J(vu)*v (not ghosted)
1654: -    w - any user data

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

1658:    Level: advanced

1660: .seealso: DAFormFunction1()

1662: @*/
1663: int DAMultiplyByJacobian1WithAdifor(DA da,Vec u,Vec v,Vec f,void *w)
1664: {
1665:   int         ierr;
1666:   PetscScalar *au,*av,*af,*awork;
1667:   Vec         work;
1668:   DALocalInfo info;
1669:   void        (*lf)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,int*) =
1670:               (void (*)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,int*))*da->adiformf_lf;

1673:   DAGetLocalInfo(da,&info);

1675:   DAGetGlobalVector(da,&work);
1676:   VecGetArray(u,&au);
1677:   VecGetArray(v,&av);
1678:   VecGetArray(f,&af);
1679:   VecGetArray(work,&awork);
1680:   (lf)(&info,au,av,awork,af,w,&ierr);
1681:   VecRestoreArray(u,&au);
1682:   VecRestoreArray(v,&av);
1683:   VecRestoreArray(f,&af);
1684:   VecRestoreArray(work,&awork);
1685:   DARestoreGlobalVector(da,&work);

1687:   return(0);
1688: }

1692: /*@C
1693:        DASetInterpolationType - Sets the type of interpolation that will be 
1694:           returned by DAGetInterpolation()

1696:    Collective on DA

1698:    Input Parameter:
1699: +  da - initial distributed array
1700: .  ctype - DA_Q1 and DA_Q0 are currently the only supported forms

1702:    Level: intermediate

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

1706: .keywords:  distributed array, interpolation

1708: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DA, DAInterpolationType
1709: @*/
1710: int DASetInterpolationType(DA da,DAInterpolationType ctype)
1711: {
1714:   da->interptype = ctype;
1715:   return(0);
1716: }