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

  5: int DAGetOwnershipRange(DA da,int **lx,int **ly,int **lz)
  6: {
  9:   if (lx) *lx = da->lx;
 10:   if (ly) *ly = da->ly;
 11:   if (lz) *lz = da->lz;
 12:   return(0);
 13: }

 15: int DAView_2d(DA da,PetscViewer viewer)
 16: {
 17:   int        rank,ierr;
 18:   PetscTruth isascii,isdraw,isbinary;

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

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

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

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

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

 76:     PetscDrawSynchronizedFlush(draw);
 77:     PetscDrawPause(draw);
 78:     /* overlay ghost numbers, useful for error checking */
 79:     /* put in numbers */

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

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

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

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

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

151:   return(0);
152: }
153: EXTERN_C_END
154: #endif

156: int DAPublish_Petsc(PetscObject obj)
157: {
158: #if defined(PETSC_HAVE_AMS)
159:   DA          v = (DA) obj;
160:   int         ierr;
161: #endif


165: #if defined(PETSC_HAVE_AMS)
166:   /* if it is already published then return */
167:   if (v->amem >=0) return(0);

169:   PetscObjectPublishBaseBegin(obj);
170:   PetscObjectPublishBaseEnd(obj);
171: #endif

173:   return(0);
174: }

176: /*
177:    This allows the DA vectors to properly tell Matlab their dimensions
178: */
179: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
180: #include "engine.h"   /* Matlab include file */
181: #include "mex.h"      /* Matlab include file */
182: EXTERN_C_BEGIN
183: int VecMatlabEnginePut_DA2d(PetscObject obj,void *engine)
184: {
185:   int     ierr,n,m;
186:   Vec     vec = (Vec)obj;
187:   PetscScalar  *array;
188:   mxArray *mat;
189:   DA      da;

192:   PetscObjectQuery((PetscObject)vec,"DA",(PetscObject*)&da);
193:   if (!da) SETERRQ(1,"Vector not associated with a DA");
194:   DAGetGhostCorners(da,0,0,0,&m,&n,0);

196:   VecGetArray(vec,&array);
197: #if !defined(PETSC_USE_COMPLEX)
198:   mat  = mxCreateDoubleMatrix(m,n,mxREAL);
199: #else
200:   mat  = mxCreateDoubleMatrix(m,n,mxCOMPLEX);
201: #endif
202:   PetscMemcpy(mxGetPr(mat),array,n*m*sizeof(PetscScalar));
203:   PetscObjectName(obj);
204:   mxSetName(mat,obj->name);
205:   engPutArray((Engine *)engine,mat);
206: 
207:   VecRestoreArray(vec,&array);
208:   return(0);
209: }
210: EXTERN_C_END
211: #endif

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

217:    Collective on MPI_Comm

219:    Input Parameters:
220: +  comm - MPI communicator
221: .  wrap - type of periodicity should the array have. 
222:          Use one of DA_NONPERIODIC, DA_XPERIODIC, DA_YPERIODIC, or DA_XYPERIODIC.
223: .  stencil_type - stencil type.  Use either DA_STENCIL_BOX or DA_STENCIL_STAR.
224: .  M,N - global dimension in each direction of the array
225: .  m,n - corresponding number of processors in each dimension 
226:          (or PETSC_DECIDE to have calculated)
227: .  dof - number of degrees of freedom per node
228: .  s - stencil width
229: -  lx, ly - arrays containing the number of nodes in each cell along
230:            the x and y coordinates, or PETSC_NULL. If non-null, these
231:            must be of length as m and n, and the corresponding
232:            m and n cannot be PETSC_DECIDE. The sum of the lx[] entries
233:            must be M, and the sum of the ly[] entries must be N.

235:    Output Parameter:
236: .  inra - the resulting distributed array object

238:    Options Database Key:
239: +  -da_view - Calls DAView() at the conclusion of DACreate2d()
240: .  -da_grid_x <nx> - number of grid points in x direction, if M < 0
241: .  -da_grid_y <ny> - number of grid points in y direction, if N < 0
242: .  -da_processors_x <nx> - number of processors in x direction
243: .  -da_processors_y <ny> - number of processors in y direction
244: -  -da_noao - do not compute natural to PETSc ordering object

246:    Level: beginner

248:    Notes:
249:    If you are having problems with running out of memory than run with the option -da_noao

251:    The stencil type DA_STENCIL_STAR with width 1 corresponds to the 
252:    standard 5-pt stencil, while DA_STENCIL_BOX with width 1 denotes
253:    the standard 9-pt stencil.

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

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

261: .seealso: DADestroy(), DAView(), DACreate1d(), DACreate3d(), DAGlobalToLocalBegin(),
262:           DAGlobalToLocalEnd(), DALocalToGlobal(), DALocalToLocalBegin(), DALocalToLocalEnd(),
263:           DAGetInfo(), DACreateGlobalVector(), DACreateLocalVector(), DACreateNaturalVector(), DALoad(), DAView()

265: @*/
266: int DACreate2d(MPI_Comm comm,DAPeriodicType wrap,DAStencilType stencil_type,
267:                 int M,int N,int m,int n,int dof,int s,int *lx,int *ly,DA *inra)
268: {
269:   int           rank,size,xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,ierr,start,end;
270:   int           up,down,left,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn;
271:   int           xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count;
272:   int           s_x,s_y; /* s proportionalized to w */
273:   int           *gA,*gB,*gAall,*gBall,ict,ldim,gdim,*flx = 0,*fly = 0;
274:   int           sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0,refine_x = 2, refine_y = 2,tM = M,tN = N;
275:   PetscTruth    flg1,flg2;
276:   DA            da;
277:   Vec           local,global;
278:   VecScatter    ltog,gtol;
279:   IS            to,from;

283:   *inra = 0;
284: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
285:   DMInitializePackage(PETSC_NULL);
286: #endif

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

291:   PetscOptionsBegin(comm,PETSC_NULL,"2d DA Options","DA");
292:     if (M < 0){
293:       tM = -M;
294:       PetscOptionsInt("-da_grid_x","Number of grid points in x direction","DACreate2d",tM,&tM,PETSC_NULL);
295:     }
296:     if (N < 0){
297:       tN = -N;
298:       PetscOptionsInt("-da_grid_y","Number of grid points in y direction","DACreate2d",tN,&tN,PETSC_NULL);
299:     }
300:     PetscOptionsInt("-da_processors_x","Number of processors in x direction","DACreate2d",m,&m,PETSC_NULL);
301:     PetscOptionsInt("-da_processors_y","Number of processors in y direction","DACreate2d",n,&n,PETSC_NULL);
302:     PetscOptionsInt("-da_refine_x","Refinement ratio in x direction","DACreate2d",refine_x,&refine_x,PETSC_NULL);
303:     PetscOptionsInt("-da_refine_y","Refinement ratio in y direction","DACreate2d",refine_y,&refine_y,PETSC_NULL);
304:   PetscOptionsEnd();
305:   M = tM; N = tN;

307:   PetscHeaderCreate(da,_p_DA,struct _DAOps,DA_COOKIE,0,"DA",comm,DADestroy,DAView);
308:   PetscLogObjectCreate(da);
309:   da->bops->publish           = DAPublish_Petsc;
310:   da->ops->createglobalvector = DACreateGlobalVector;
311:   da->ops->getinterpolation   = DAGetInterpolation;
312:   da->ops->getcoloring        = DAGetColoring;
313:   da->ops->getmatrix          = DAGetMatrix;
314:   da->ops->refine             = DARefine;
315:   PetscLogObjectMemory(da,sizeof(struct _p_DA));
316:   da->dim        = 2;
317:   da->interptype = DA_Q1;
318:   da->gtog1      = 0;
319:   da->refine_x   = refine_x;
320:   da->refine_y   = refine_y;
321:   PetscMalloc(dof*sizeof(char*),&da->fieldname);
322:   PetscMemzero(da->fieldname,dof*sizeof(char*));

324:   MPI_Comm_size(comm,&size);
325:   MPI_Comm_rank(comm,&rank);

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

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

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

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

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

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

430:   xe = xs + x;
431:   ye = ys + y;

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

440:   /* X Periodic */
441:   if (DAXPeriodic(wrap)){
442:     Xs = xs - s;
443:     Xe = xe + s;
444:   }

446:   /* Y Periodic */
447:   if (DAYPeriodic(wrap)){
448:     Ys = ys - s;
449:     Ye = ye + s;
450:   }

452:   /* Resize all X parameters to reflect w */
453:   x   *= dof;
454:   xs  *= dof;
455:   xe  *= dof;
456:   Xs  *= dof;
457:   Xe  *= dof;
458:   s_x = s*dof;
459:   s_y = s;

461:   /* determine starting point of each processor */
462:   nn = x*y;
463:   PetscMalloc((2*size+1)*sizeof(int),&bases);
464:   ldims = (int*)(bases+size+1);
465:   MPI_Allgather(&nn,1,MPI_INT,ldims,1,MPI_INT,comm);
466:   bases[0] = 0;
467:   for (i=1; i<=size; i++) {
468:     bases[i] = ldims[i-1];
469:   }
470:   for (i=1; i<=size; i++) {
471:     bases[i] += bases[i-1];
472:   }

474:   /* allocate the base parallel and sequential vectors */
475:   VecCreateMPI(comm,x*y,PETSC_DECIDE,&global);
476:   VecSetBlockSize(global,dof);
477:   VecCreateSeq(PETSC_COMM_SELF,(Xe-Xs)*(Ye-Ys),&local);
478:   VecSetBlockSize(local,dof);


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

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

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

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


545:   /* determine who lies on each side of use stored in    n6 n7 n8
546:                                                          n3    n5
547:                                                          n0 n1 n2
548:   */

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


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

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

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

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

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

619:   PetscMalloc((x+2*s_x)*(y+2*s_y)*sizeof(int),&idx);
620:   PetscLogObjectMemory(da,(x+2*s_x)*(y+2*s_y)*sizeof(int));
621:   nn = 0;

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

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

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

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

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

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

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

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

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

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

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

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

767:   PetscLogObjectParent(da,global);
768:   PetscLogObjectParent(da,local);

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

781:   /* 
782:      Set the local to global ordering in the global vector, this allows use
783:      of VecSetValuesLocal().
784:   */
785:   ISLocalToGlobalMappingCreate(comm,nn,idx,&da->ltogmap);
786:   VecSetLocalToGlobalMapping(da->global,da->ltogmap);
787:   ISLocalToGlobalMappingBlock(da->ltogmap,da->w,&da->ltogmapb);
788:   VecSetLocalToGlobalMappingBlock(da->global,da->ltogmapb);
789:   PetscLogObjectParent(da,da->ltogmap);

791:   *inra = da;

793:   /* recalculate the idx including missed ghost points */
794:   /* Assume the Non-Periodic Case */
795:   n1 = rank - m;
796:   if (rank % m) {
797:     n0 = n1 - 1;
798:   } else {
799:     n0 = -1;
800:   }
801:   if ((rank+1) % m) {
802:     n2 = n1 + 1;
803:     n5 = rank + 1;
804:     n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
805:   } else {
806:     n2 = -1; n5 = -1; n8 = -1;
807:   }
808:   if (rank % m) {
809:     n3 = rank - 1;
810:     n6 = n3 + m; if (n6 >= m*n) n6 = -1;
811:   } else {
812:     n3 = -1; n6 = -1;
813:   }
814:   n7 = rank + m; if (n7 >= m*n) n7 = -1;


817:   /* Modify for Periodic Cases */
818:   if (wrap == DA_YPERIODIC) {  /* Handle Top and Bottom Sides */
819:     if (n1 < 0) n1 = rank + m * (n-1);
820:     if (n7 < 0) n7 = rank - m * (n-1);
821:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
822:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
823:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
824:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
825:   } else if (wrap == DA_XPERIODIC) { /* Handle Left and Right Sides */
826:     if (n3 < 0) n3 = rank + (m-1);
827:     if (n5 < 0) n5 = rank - (m-1);
828:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
829:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
830:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
831:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
832:   } else if (wrap == DA_XYPERIODIC) {

834:     /* Handle all four corners */
835:     if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
836:     if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
837:     if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
838:     if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;

840:     /* Handle Top and Bottom Sides */
841:     if (n1 < 0) n1 = rank + m * (n-1);
842:     if (n7 < 0) n7 = rank - m * (n-1);
843:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
844:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
845:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
846:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;

848:     /* Handle Left and Right Sides */
849:     if (n3 < 0) n3 = rank + (m-1);
850:     if (n5 < 0) n5 = rank - (m-1);
851:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
852:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
853:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
854:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
855:   }

857:   nn = 0;

859:   xbase = bases[rank];
860:   for (i=1; i<=s_y; i++) {
861:     if (n0 >= 0) { /* left below */
862:       x_t = lx[n0 % m]*dof;
863:       y_t = ly[(n0/m)];
864:       s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
865:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
866:     }
867:     if (n1 >= 0) { /* directly below */
868:       x_t = x;
869:       y_t = ly[(n1/m)];
870:       s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
871:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
872:     }
873:     if (n2 >= 0) { /* right below */
874:       x_t = lx[n2 % m]*dof;
875:       y_t = ly[(n2/m)];
876:       s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
877:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
878:     }
879:   }

881:   for (i=0; i<y; i++) {
882:     if (n3 >= 0) { /* directly left */
883:       x_t = lx[n3 % m]*dof;
884:       /* y_t = y; */
885:       s_t = bases[n3] + (i+1)*x_t - s_x;
886:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
887:     }

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

891:     if (n5 >= 0) { /* directly right */
892:       x_t = lx[n5 % m]*dof;
893:       /* y_t = y; */
894:       s_t = bases[n5] + (i)*x_t;
895:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
896:     }
897:   }

899:   for (i=1; i<=s_y; i++) {
900:     if (n6 >= 0) { /* left above */
901:       x_t = lx[n6 % m]*dof;
902:       /* y_t = ly[(n6/m)]; */
903:       s_t = bases[n6] + (i)*x_t - s_x;
904:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
905:     }
906:     if (n7 >= 0) { /* directly above */
907:       x_t = x;
908:       /* y_t = ly[(n7/m)]; */
909:       s_t = bases[n7] + (i-1)*x_t;
910:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
911:     }
912:     if (n8 >= 0) { /* right above */
913:       x_t = lx[n8 % m]*dof;
914:       /* y_t = ly[(n8/m)]; */
915:       s_t = bases[n8] + (i-1)*x_t;
916:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
917:     }
918:   }
919:   /* keep bases for use at end of routine */
920:   /* PetscFree(bases); */

922:   /* construct the local to local scatter context */
923:   /* 
924:       We simply remap the values in the from part of 
925:     global to local to read from an array with the ghost values 
926:     rather then from the plan array.
927:   */
928:   VecScatterCopy(gtol,&da->ltol);
929:   PetscLogObjectParent(da,da->ltol);
930:   left  = xs - Xs; down  = ys - Ys; up    = down + y;
931:   PetscMalloc(x*(up - down)*sizeof(int),&idx);
932:   count = 0;
933:   for (i=down; i<up; i++) {
934:     for (j=0; j<x; j++) {
935:       idx[count++] = left + i*(Xe-Xs) + j;
936:     }
937:   }
938:   VecScatterRemap(da->ltol,idx,PETSC_NULL);
939:   PetscFree(idx);

941:   /* 
942:      Build the natural ordering to PETSc ordering mappings.
943:   */
944:   PetscOptionsHasName(PETSC_NULL,"-da_noao",&flg1);
945:   if (!flg1) {
946:     IS  ispetsc,isnatural;
947:     int *lidx,lict = 0,Nlocal = (da->xe-da->xs)*(da->ye-da->ys);

949:     ISCreateStride(comm,Nlocal,da->base,1,&ispetsc);

951:     PetscMalloc(Nlocal*sizeof(int),&lidx);
952:     for (j=ys; j<ye; j++) {
953:       for (i=xs; i<xe; i++) {
954:         /*  global number in natural ordering */
955:         lidx[lict++] = i + j*M*dof;
956:       }
957:     }
958:     ISCreateGeneral(comm,Nlocal,lidx,&isnatural);
959:     PetscFree(lidx);


962:     AOCreateBasicIS(isnatural,ispetsc,&da->ao);
963:     PetscLogObjectParent(da,da->ao);
964:     ISDestroy(ispetsc);
965:     ISDestroy(isnatural);
966:   } else {
967:     da->ao = PETSC_NULL;
968:   }

970:   if (!flx) {
971:     PetscMalloc(m*sizeof(int),&flx);
972:     PetscMemcpy(flx,lx,m*sizeof(int));
973:   }
974:   if (!fly) {
975:     PetscMalloc(n*sizeof(int),&fly);
976:     PetscMemcpy(fly,ly,n*sizeof(int));
977:   }
978:   da->lx = flx;
979:   da->ly = fly;

981:   /*
982:      Note the following will be removed soon. Since the functionality 
983:     is replaced by the above.
984:   */
985:   /* Construct the mapping from current global ordering to global
986:      ordering that would be used if only 1 processor were employed.
987:      This mapping is intended only for internal use by discrete
988:      function and matrix viewers.

990:      Note: At this point, x has already been adjusted for multiple
991:      degrees of freedom per node.
992:    */
993:   ldim = x*y;
994:   VecGetSize(global,&gdim);
995:   PetscMalloc(gdim*sizeof(int),&da->gtog1);
996:   PetscLogObjectMemory(da,gdim*sizeof(int));
997:   PetscMalloc((2*(gdim+ldim))*sizeof(int),&gA);
998:   gB        = (int *)(gA + ldim);
999:   gAall     = (int *)(gB + ldim);
1000:   gBall     = (int *)(gAall + gdim);

1002:   /* Compute local parts of global orderings */
1003:   ict = 0;
1004:   for (j=ys; j<ye; j++) {
1005:     for (i=xs; i<xe; i++) {
1006:       /* gA = global number for 1 proc; gB = current global number */
1007:       gA[ict] = i + j*M*dof;
1008:       gB[ict] = start + ict;
1009:       ict++;
1010:     }
1011:   }
1012:   /* Broadcast the orderings */
1013:   MPI_Allgatherv(gA,ldim,MPI_INT,gAall,ldims,bases,MPI_INT,comm);
1014:   MPI_Allgatherv(gB,ldim,MPI_INT,gBall,ldims,bases,MPI_INT,comm);
1015:   for (i=0; i<gdim; i++) da->gtog1[gBall[i]] = gAall[i];
1016:   PetscFree(gA);
1017:   PetscFree(bases);

1019:   PetscOptionsHasName(PETSC_NULL,"-da_view",&flg1);
1020:   if (flg1) {DAView(da,PETSC_VIEWER_STDOUT_(da->comm));}
1021:   PetscOptionsHasName(PETSC_NULL,"-da_view_draw",&flg1);
1022:   if (flg1) {DAView(da,PETSC_VIEWER_DRAW_(da->comm));}
1023:   PetscOptionsHasName(PETSC_NULL,"-help",&flg1);
1024:   if (flg1) {DAPrintHelp(da);}

1026:   PetscPublishAll(da);
1027: #if defined(PETSC_HAVE_AMS)
1028:   PetscObjectComposeFunctionDynamic((PetscObject)global,"AMSSetFieldBlock_C",
1029:          "AMSSetFieldBlock_DA",AMSSetFieldBlock_DA);
1030:   PetscObjectComposeFunctionDynamic((PetscObject)local,"AMSSetFieldBlock_C",
1031:          "AMSSetFieldBlock_DA",AMSSetFieldBlock_DA);
1032:   if (((PetscObject)global)->amem > -1) {
1033:     AMSSetFieldBlock_DA(((PetscObject)global)->amem,"values",global);
1034:   }
1035: #endif
1036: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1037:   if (dof == 1) {
1038:     PetscObjectComposeFunctionDynamic((PetscObject)local,"PetscMatlabEnginePut_C","VecMatlabEnginePut_DA2d",VecMatlabEnginePut_DA2d);
1039:   }
1040: #endif
1041:   VecSetOperation(global,VECOP_VIEW,(void(*)(void))VecView_MPI_DA);
1042:   VecSetOperation(global,VECOP_LOADINTOVECTOR,(void(*)(void))VecLoadIntoVector_Binary_DA);
1043:   return(0);
1044: }

1046: /*@
1047:    DAPrintHelp - Prints command line options for DA.

1049:    Collective on DA

1051:    Input Parameters:
1052: .  da - the distributed array

1054:    Level: intermediate

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

1058: .keywords: DA, help

1060: @*/
1061: int DAPrintHelp(DA da)
1062: {
1063:   static PetscTruth called = PETSC_FALSE;
1064:   MPI_Comm          comm;
1065:   int               ierr;


1070:   comm = da->comm;
1071:   if (!called) {
1072:     (*PetscHelpPrintf)(comm,"General Distributed Array (DA) options:n");
1073:     (*PetscHelpPrintf)(comm,"  -da_view: print DA distribution to screenn");
1074:     (*PetscHelpPrintf)(comm,"  -da_view_draw: display DA in windown");
1075:     called = PETSC_TRUE;
1076:   }
1077:   return(0);
1078: }

1080: /*@C
1081:    DARefine - Creates a new distributed array that is a refinement of a given
1082:    distributed array.

1084:    Collective on DA

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

1091:    Output Parameter:
1092: .  daref - refined distributed array

1094:    Level: advanced

1096:    Note:
1097:    Currently, refinement consists of just doubling the number of grid spaces
1098:    in each dimension of the DA.

1100: .keywords:  distributed array, refine

1102: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy()
1103: @*/
1104: int DARefine(DA da,MPI_Comm comm,DA *daref)
1105: {
1106:   int M,N,P,ierr;
1107:   DA  da2;


1112:   if (DAXPeriodic(da->wrap) || da->interptype == DA_Q0){
1113:     M = da->refine_x*da->M;
1114:   } else {
1115:     M = 1 + da->refine_x*(da->M - 1);
1116:   }
1117:   if (DAYPeriodic(da->wrap) || da->interptype == DA_Q0){
1118:     N = da->refine_y*da->N;
1119:   } else {
1120:     N = 1 + da->refine_y*(da->N - 1);
1121:   }
1122:   if (DAZPeriodic(da->wrap) || da->interptype == DA_Q0){
1123:     P = da->refine_z*da->P;
1124:   } else {
1125:     P = 1 + da->refine_z*(da->P - 1);
1126:   }
1127:   if (da->dim == 1) {
1128:     DACreate1d(da->comm,da->wrap,M,da->w,da->s,PETSC_NULL,&da2);
1129:   } else if (da->dim == 2) {
1130:     DACreate2d(da->comm,da->wrap,da->stencil_type,M,N,da->m,da->n,da->w,da->s,PETSC_NULL,PETSC_NULL,&da2);
1131:   } else if (da->dim == 3) {
1132:     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);
1133:   }
1134:   *daref = da2;
1135:   return(0);
1136: }

1138: /*
1139:       M is number of grid points 
1140:       m is number of processors

1142: */
1143: int DASplitComm2d(MPI_Comm comm,int M,int N,int sw,MPI_Comm *outcomm)
1144: {
1145:   int ierr,m,n = 0,csize,size,rank,x = 0,y = 0;

1148:   MPI_Comm_size(comm,&size);
1149:   MPI_Comm_rank(comm,&rank);

1151:   csize = 4*size;
1152:   do {
1153:     if (csize % 4) SETERRQ4(1,"Cannot split communicator of size %d tried %d %d %d",size,csize,x,y);
1154:     csize   = csize/4;
1155: 
1156:     m = (int)(0.5 + sqrt(((double)M)*((double)csize)/((double)N)));
1157:     if (!m) m = 1;
1158:     while (m > 0) {
1159:       n = csize/m;
1160:       if (m*n == csize) break;
1161:       m--;
1162:     }
1163:     if (M > N && m < n) {int _m = m; m = n; n = _m;}

1165:     x = M/m + ((M % m) > ((csize-1) % m));
1166:     y = (N + (csize-1)/m)/n;
1167:   } while ((x < 4 || y < 4) && csize > 1);
1168:   if (size != csize) {
1169:     MPI_Group entire_group,sub_group;
1170:     int       i,*groupies;

1172:     ierr     = MPI_Comm_group(comm,&entire_group);
1173:     PetscMalloc(csize*sizeof(int),&groupies);
1174:     for (i=0; i<csize; i++) {
1175:       groupies[i] = (rank/csize)*csize + i;
1176:     }
1177:     ierr     = MPI_Group_incl(entire_group,csize,groupies,&sub_group);
1178:     ierr     = PetscFree(groupies);
1179:     ierr     = MPI_Comm_create(comm,sub_group,outcomm);
1180:     ierr     = MPI_Group_free(&entire_group);
1181:     ierr     = MPI_Group_free(&sub_group);
1182:     PetscLogInfo(0,"Creating redundant coarse problems of size %dn",csize);
1183:   } else {
1184:     *outcomm = comm;
1185:   }
1186:   return(0);
1187: }

1189: /*@C
1190:        DASetLocalFunction - Caches in a DA a local function

1192:    Collective on DA

1194:    Input Parameter:
1195: +  da - initial distributed array
1196: -  lf - the local function

1198:    Level: intermediate

1200: .keywords:  distributed array, refine

1202: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunctioni()
1203: @*/
1204: int DASetLocalFunction(DA da,DALocalFunction1 lf)
1205: {
1208:   da->lf    = lf;
1209:   return(0);
1210: }

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

1215:    Collective on DA

1217:    Input Parameter:
1218: +  da - initial distributed array
1219: -  lfi - the local function

1221:    Level: intermediate

1223: .keywords:  distributed array, refine

1225: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1226: @*/
1227: int DASetLocalFunctioni(DA da,int (*lfi)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*))
1228: {
1231:   da->lfi = lfi;
1232:   return(0);
1233: }

1235: /*MC
1236:        DASetLocalAdicFunction - Caches in a DA a local function computed by ADIC/ADIFOR

1238:    Collective on DA

1240:    Synopsis:
1241:    int int DASetLocalAdicFunction(DA da,DALocalFunction1 ad_lf)
1242:    
1243:    Input Parameter:
1244: +  da - initial distributed array
1245: -  ad_lf - the local function as computed by ADIC/ADIFOR

1247:    Level: intermediate

1249: .keywords:  distributed array, refine

1251: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1252:           DASetLocalJacobian()
1253: M*/

1255: int DASetLocalAdicFunction_Private(DA da,DALocalFunction1 ad_lf)
1256: {
1259:   da->adic_lf = ad_lf;
1260:   return(0);
1261: }

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

1266:    Collective on DA

1268:    Synopsis:
1269:    int int DASetLocalAdicFunctioni(DA da,int (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1270:    
1271:    Input Parameter:
1272: +  da - initial distributed array
1273: -  ad_lfi - the local function as computed by ADIC/ADIFOR

1275:    Level: intermediate

1277: .keywords:  distributed array, refine

1279: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1280:           DASetLocalJacobian(), DASetLocalFunctioni()
1281: M*/

1283: int DASetLocalAdicFunctioni_Private(DA da,int (*ad_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1284: {
1287:   da->adic_lfi = ad_lfi;
1288:   return(0);
1289: }

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

1294:    Collective on DA

1296:    Synopsis:
1297:    int int DASetLocalAdicFunctioni(DA da,int (ad_lf*)(DALocalInfo*,MatStencil*,void*,void*,void*)
1298:    
1299:    Input Parameter:
1300: +  da - initial distributed array
1301: -  admf_lfi - the local matrix-free function as computed by ADIC/ADIFOR

1303:    Level: intermediate

1305: .keywords:  distributed array, refine

1307: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1308:           DASetLocalJacobian(), DASetLocalFunctioni()
1309: M*/

1311: int DASetLocalAdicMFFunctioni_Private(DA da,int (*admf_lfi)(DALocalInfo*,MatStencil*,void*,void*,void*))
1312: {
1315:   da->adicmf_lfi = admf_lfi;
1316:   return(0);
1317: }

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

1322:    Collective on DA

1324:    Synopsis:
1325:    int int DASetLocalAdicMFFunction(DA da,DALocalFunction1 ad_lf)
1326:    
1327:    Input Parameter:
1328: +  da - initial distributed array
1329: -  ad_lf - the local function as computed by ADIC/ADIFOR

1331:    Level: intermediate

1333: .keywords:  distributed array, refine

1335: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction(),
1336:           DASetLocalJacobian()
1337: M*/

1339: int DASetLocalAdicMFFunction_Private(DA da,DALocalFunction1 ad_lf)
1340: {
1343:   da->adicmf_lf = ad_lf;
1344:   return(0);
1345: }

1347: /*@C
1348:        DASetLocalJacobian - Caches in a DA a local Jacobian

1350:    Collective on DA

1352:    
1353:    Input Parameter:
1354: +  da - initial distributed array
1355: -  lj - the local Jacobian

1357:    Level: intermediate

1359: .keywords:  distributed array, refine

1361: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DAGetLocalFunction(), DASetLocalFunction()
1362: @*/
1363: int DASetLocalJacobian(DA da,DALocalFunction1 lj)
1364: {
1367:   da->lj    = lj;
1368:   return(0);
1369: }

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

1374:    Collective on DA

1376:    Input Parameter:
1377: .  da - initial distributed array

1379:    Output Parameters:
1380: .  lf - the local function

1382:    Level: intermediate

1384: .keywords:  distributed array, refine

1386: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DASetLocalFunction()
1387: @*/
1388: int DAGetLocalFunction(DA da,DALocalFunction1 *lf)
1389: {
1392:   if (lf)       *lf = da->lf;
1393:   return(0);
1394: }

1396: /*@
1397:     DAFormFunction1 - Evaluates a user provided function on each processor that 
1398:         share a DA

1400:    Input Parameters:
1401: +    da - the DA that defines the grid
1402: .    vu - input vector
1403: .    vfu - output vector 
1404: -    w - any user data

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

1408:     Level: advanced

1410: .seealso: DAComputeJacobian1WithAdic()

1412: @*/
1413: int DAFormFunction1(DA da,Vec vu,Vec vfu,void *w)
1414: {
1415:   int         ierr;
1416:   void        *u,*fu;
1417:   DALocalInfo info;
1418: 

1421:   DAGetLocalInfo(da,&info);
1422:   DAVecGetArray(da,vu,(void**)&u);
1423:   DAVecGetArray(da,vfu,(void**)&fu);

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

1427:   DAVecRestoreArray(da,vu,(void**)&u);
1428:   DAVecRestoreArray(da,vfu,(void**)&fu);
1429:   return(0);
1430: }

1432: int DAFormFunctioniTest1(DA da,void *w)
1433: {
1434:   Vec         vu,fu,fui;
1435:   int         ierr,i,n;
1436:   PetscScalar *ui,mone = -1.0;
1437:   PetscRandom rnd;
1438:   PetscReal   norm;

1441:   DAGetLocalVector(da,&vu);
1442:   PetscRandomCreate(PETSC_COMM_SELF,RANDOM_DEFAULT,&rnd);
1443:   VecSetRandom(rnd,vu);
1444:   PetscRandomDestroy(rnd);

1446:   DAGetGlobalVector(da,&fu);
1447:   DAGetGlobalVector(da,&fui);
1448: 
1449:   DAFormFunction1(da,vu,fu,w);

1451:   VecGetArray(fui,&ui);
1452:   VecGetLocalSize(fui,&n);
1453:   for (i=0; i<n; i++) {
1454:     DAFormFunctioni1(da,i,vu,ui+i,w);
1455:   }
1456:   VecRestoreArray(fui,&ui);

1458:   VecAXPY(&mone,fu,fui);
1459:   VecNorm(fui,NORM_2,&norm);
1460:   PetscPrintf(da->comm,"Norm of difference in vectors %gn",norm);
1461:   VecView(fu,0);
1462:   VecView(fui,0);

1464:   DARestoreLocalVector(da,&vu);
1465:   DARestoreGlobalVector(da,&fu);
1466:   DARestoreGlobalVector(da,&fui);
1467:   return(0);
1468: }

1470: /*@
1471:     DAFormFunctioni1 - Evaluates a user provided function

1473:    Input Parameters:
1474: +    da - the DA that defines the grid
1475: .    i - the component of the function we wish to compute (must be local)
1476: .    vu - input vector
1477: .    vfu - output value
1478: -    w - any user data

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

1482:     Level: advanced

1484: .seealso: DAComputeJacobian1WithAdic()

1486: @*/
1487: int DAFormFunctioni1(DA da,int i,Vec vu,PetscScalar *vfu,void *w)
1488: {
1489:   int         ierr;
1490:   void        *u;
1491:   DALocalInfo info;
1492:   MatStencil  stencil;
1493: 

1496:   DAGetLocalInfo(da,&info);
1497:   DAVecGetArray(da,vu,(void**)&u);

1499:   /* figure out stencil value from i */
1500:   stencil.c = i % info.dof;
1501:   stencil.i = (i % (info.xm*info.dof))/info.dof;
1502:   stencil.j = (i % (info.xm*info.ym*info.dof))/(info.xm*info.dof);
1503:   stencil.k = i/(info.xm*info.ym*info.dof);

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

1507:   DAVecRestoreArray(da,vu,(void**)&u);
1508:   return(0);
1509: }

1511: #if defined(new)
1512: /*
1513:   DAGetDiagonal_MFFD - Gets the diagonal for a matrix free matrix where local
1514:     function lives on a DA

1516:         y ~= (F(u + ha) - F(u))/h, 
1517:   where F = nonlinear function, as set by SNESSetFunction()
1518:         u = current iterate
1519:         h = difference interval
1520: */
1521: int DAGetDiagonal_MFFD(DA da,Vec U,Vec a)
1522: {
1523:   PetscScalar  h,*aa,*ww,v;
1524:   PetscReal    epsilon = PETSC_SQRT_MACHINE_EPSILON,umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
1525:   int          ierr,gI,nI;
1526:   MatStencil   stencil;
1527:   DALocalInfo  info;
1528: 
1530:   (*ctx->func)(0,U,a,ctx->funcctx);
1531:   (*ctx->funcisetbase)(U,ctx->funcctx);

1533:   VecGetArray(U,&ww);
1534:   VecGetArray(a,&aa);
1535: 
1536:   nI = 0;
1537:     h  = ww[gI];
1538:     if (h == 0.0) h = 1.0;
1539: #if !defined(PETSC_USE_COMPLEX)
1540:     if (h < umin && h >= 0.0)      h = umin;
1541:     else if (h < 0.0 && h > -umin) h = -umin;
1542: #else
1543:     if (PetscAbsScalar(h) < umin && PetscRealPart(h) >= 0.0)     h = umin;
1544:     else if (PetscRealPart(h) < 0.0 && PetscAbsScalar(h) < umin) h = -umin;
1545: #endif
1546:     h     *= epsilon;
1547: 
1548:     ww[gI += h;
1549:     ierr          = (*ctx->funci)(i,w,&v,ctx->funcctx);
1550:     aa[nI]  = (v - aa[nI])/h;
1551:     ww[gI] -= h;
1552:     nI++;
1553:   }
1554:   VecRestoreArray(U,&ww);
1555:   VecRestoreArray(a,&aa);
1556:   return(0);
1557: }
1558: #endif

1560: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1561: EXTERN_C_BEGIN
1562: #include "adic/ad_utils.h"
1563: EXTERN_C_END

1565: /*@
1566:     DAComputeJacobian1WithAdic - Evaluates a adiC provided Jacobian function on each processor that 
1567:         share a DA

1569:    Input Parameters:
1570: +    da - the DA that defines the grid
1571: .    vu - input vector (ghosted)
1572: .    J - output matrix
1573: -    w - any user data

1575:    Level: advanced

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

1579: .seealso: DAFormFunction1()

1581: @*/
1582: int DAComputeJacobian1WithAdic(DA da,Vec vu,Mat J,void *w)
1583: {
1584:   int         ierr,gtdof,tdof;
1585:   PetscScalar *ustart;
1586:   DALocalInfo info;
1587:   void        *ad_u,*ad_f,*ad_ustart,*ad_fstart;
1588:   ISColoring  iscoloring;

1591:   DAGetLocalInfo(da,&info);

1593:   /* get space for derivative objects.  */
1594:   DAGetAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1595:   DAGetAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1596:   VecGetArray(vu,&ustart);
1597:   PetscADSetValArray(((DERIV_TYPE*)ad_ustart),gtdof,ustart);
1598:   VecRestoreArray(vu,&ustart);

1600:   PetscADResetIndep();
1601:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);
1602:   PetscADSetIndepArrayColored(ad_ustart,gtdof,iscoloring->colors);
1603:   PetscADIncrementTotalGradSize(iscoloring->n);
1604:   ISColoringDestroy(iscoloring);
1605:   PetscADSetIndepDone();

1607:   (*da->adic_lf)(&info,ad_u,ad_f,w);

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

1612:   /* return space for derivative objects.  */
1613:   DARestoreAdicArray(da,PETSC_TRUE,(void **)&ad_u,&ad_ustart,&gtdof);
1614:   DARestoreAdicArray(da,PETSC_FALSE,(void **)&ad_f,&ad_fstart,&tdof);
1615:   return(0);
1616: }

1618: /*@C
1619:     DAMultiplyByJacobian1WithAdic - Applies an ADIC-provided Jacobian function to a vector on 
1620:     each processor that shares a DA.

1622:     Input Parameters:
1623: +   da - the DA that defines the grid
1624: .   vu - Jacobian is computed at this point (ghosted)
1625: .   v - product is done on this vector (ghosted)
1626: .   fu - output vector = J(vu)*v (not ghosted)
1627: -   w - any user data

1629:     Notes: 
1630:     This routine does NOT do ghost updates on vu upon entry.

1632:    Level: advanced

1634: .seealso: DAFormFunction1()

1636: @*/
1637: int DAMultiplyByJacobian1WithAdic(DA da,Vec vu,Vec v,Vec f,void *w)
1638: {
1639:   int         ierr,i,gtdof,tdof;
1640:   PetscScalar *avu,*av,*af,*ad_vustart,*ad_fstart;
1641:   DALocalInfo info;
1642:   void        *ad_vu,*ad_f;

1645:   DAGetLocalInfo(da,&info);

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

1651:   /* copy input vector into derivative object */
1652:   VecGetArray(vu,&avu);
1653:   VecGetArray(v,&av);
1654:   for (i=0; i<gtdof; i++) {
1655:     ad_vustart[2*i]   = avu[i];
1656:     ad_vustart[2*i+1] = av[i];
1657:   }
1658:   VecRestoreArray(vu,&avu);
1659:   VecRestoreArray(v,&av);

1661:   PetscADResetIndep();
1662:   PetscADIncrementTotalGradSize(1);
1663:   PetscADSetIndepDone();

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

1667:   /* stick the values into the vector */
1668:   VecGetArray(f,&af);
1669:   for (i=0; i<tdof; i++) {
1670:     af[i] = ad_fstart[2*i+1];
1671:   }
1672:   VecRestoreArray(f,&af);

1674:   /* return space for derivative objects.  */
1675:   DARestoreAdicMFArray(da,PETSC_TRUE,(void **)&ad_vu,(void**)&ad_vustart,&gtdof);
1676:   DARestoreAdicMFArray(da,PETSC_FALSE,(void **)&ad_f,(void**)&ad_fstart,&tdof);
1677:   return(0);
1678: }


1681: #else

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

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

1695: #endif

1697: /*@
1698:     DAComputeJacobian1 - Evaluates a local Jacobian function on each processor that 
1699:         share a DA

1701:    Input Parameters:
1702: +    da - the DA that defines the grid
1703: .    vu - input vector (ghosted)
1704: .    J - output matrix
1705: -    w - any user data

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

1709:     Level: advanced

1711: .seealso: DAFormFunction1()

1713: @*/
1714: int DAComputeJacobian1(DA da,Vec vu,Mat J,void *w)
1715: {
1716:   int         ierr;
1717:   void        *u;
1718:   DALocalInfo info;

1721:   DAGetLocalInfo(da,&info);
1722:   DAVecGetArray(da,vu,&u);
1723:   (*da->lj)(&info,u,J,w);
1724:   DAVecRestoreArray(da,vu,&u);
1725:   return(0);
1726: }


1729: /*
1730:     DAComputeJacobian1WithAdifor - Evaluates a ADIFOR provided Jacobian local function on each processor that 
1731:         share a DA

1733:    Input Parameters:
1734: +    da - the DA that defines the grid
1735: .    vu - input vector (ghosted)
1736: .    J - output matrix
1737: -    w - any user data

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

1741: .seealso: DAFormFunction1()

1743: */
1744: int DAComputeJacobian1WithAdifor(DA da,Vec vu,Mat J,void *w)
1745: {
1746:   int         i,ierr,Nc,*color,N;
1747:   DALocalInfo info;
1748:   PetscScalar *u,*g_u,*g_f,*f,*p_u;
1749:   ISColoring  iscoloring;
1750:   void        (*lf)(int *,DALocalInfo*,PetscScalar*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,void*,int*) =
1751:               (void (*)(int *,DALocalInfo*,PetscScalar*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,void*,int*))*da->adifor_lf;

1754:   DAGetColoring(da,IS_COLORING_GHOSTED,&iscoloring);
1755:   Nc   = iscoloring->n;
1756:   DAGetLocalInfo(da,&info);
1757:   N    = info.gxm*info.gym*info.gzm*info.dof;

1759:   /* get space for derivative objects.  */
1760:   ierr  = PetscMalloc(Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar),&g_u);
1761:   ierr  = PetscMemzero(g_u,Nc*info.gxm*info.gym*info.gzm*info.dof*sizeof(PetscScalar));
1762:   p_u   = g_u;
1763:   color = iscoloring->colors;
1764:   for (i=0; i<N; i++) {
1765:     p_u[*color++] = 1.0;
1766:     p_u          += Nc;
1767:   }
1768:   ISColoringDestroy(iscoloring);
1769:   PetscMalloc(Nc*info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&g_f);
1770:   PetscMalloc(info.xm*info.ym*info.zm*info.dof*sizeof(PetscScalar),&f);

1772:   /* Seed the input array g_u with coloring information */
1773: 
1774:   VecGetArray(vu,&u);
1775:   (lf)(&Nc,&info,u,g_u,&Nc,f,g_f,&Nc,w,&ierr);
1776:   VecRestoreArray(vu,&u);

1778:   /* stick the values into the matrix */
1779:   /* PetscScalarView(Nc*info.xm*info.ym,g_f,0); */
1780:   MatSetValuesAdifor(J,Nc,g_f);

1782:   /* return space for derivative objects.  */
1783:   PetscFree(g_u);
1784:   PetscFree(g_f);
1785:   PetscFree(f);
1786:   return(0);
1787: }

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

1793:    Input Parameters:
1794: +    da - the DA that defines the grid
1795: .    vu - Jacobian is computed at this point (ghosted)
1796: .    v - product is done on this vector (ghosted)
1797: .    fu - output vector = J(vu)*v (not ghosted)
1798: -    w - any user data

1800:     Notes: 
1801:     This routine does NOT do ghost updates on vu and v upon entry.
1802:            
1803:     Automatically calls DAMultiplyByJacobian1WithAdifor() or DAMultiplyByJacobian1WithAdic()
1804:     depending on whether DASetLocalAdicMFFunction() or DASetLocalAdiforMFFunction() was called.

1806:    Level: advanced

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

1810: @*/
1811: int DAMultiplyByJacobian1WithAD(DA da,Vec u,Vec v,Vec f,void *w)
1812: {
1813:   int         ierr;

1816:   if (da->adicmf_lf) {
1817: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
1818:     DAMultiplyByJacobian1WithAdic(da,u,v,f,w);
1819: #else
1820:     SETERRQ(1,"Requires ADIC to be installed and cannot use complex numbers");
1821: #endif
1822:   } else if (da->adiformf_lf) {
1823:     DAMultiplyByJacobian1WithAdifor(da,u,v,f,w);
1824:   } else {
1825:     SETERRQ(1,"Must call DASetLocalAdiforMFFunction() or DASetLocalAdicMFFunction() before using");
1826:   }
1827:   return(0);
1828: }


1831: /*@C
1832:     DAMultiplyByJacobian1WithAdifor - Applies a ADIFOR provided Jacobian function on each processor that 
1833:         share a DA to a vector

1835:    Input Parameters:
1836: +    da - the DA that defines the grid
1837: .    vu - Jacobian is computed at this point (ghosted)
1838: .    v - product is done on this vector (ghosted)
1839: .    fu - output vector = J(vu)*v (not ghosted)
1840: -    w - any user data

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

1844:    Level: advanced

1846: .seealso: DAFormFunction1()

1848: @*/
1849: int DAMultiplyByJacobian1WithAdifor(DA da,Vec u,Vec v,Vec f,void *w)
1850: {
1851:   int         ierr;
1852:   PetscScalar *au,*av,*af,*awork;
1853:   Vec         work;
1854:   DALocalInfo info;
1855:   void        (*lf)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,int*) =
1856:               (void (*)(DALocalInfo*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,void*,int*))*da->adiformf_lf;

1859:   DAGetLocalInfo(da,&info);

1861:   DAGetGlobalVector(da,&work);
1862:   VecGetArray(u,&au);
1863:   VecGetArray(v,&av);
1864:   VecGetArray(f,&af);
1865:   VecGetArray(work,&awork);
1866:   (lf)(&info,au,av,awork,af,w,&ierr);
1867:   VecRestoreArray(u,&au);
1868:   VecRestoreArray(v,&av);
1869:   VecRestoreArray(f,&af);
1870:   VecRestoreArray(work,&awork);
1871:   DARestoreGlobalVector(da,&work);

1873:   return(0);
1874: }

1876: /*@C
1877:        DASetInterpolationType - Sets the type of interpolation that will be 
1878:           returned by DAGetInterpolation()

1880:    Collective on DA

1882:    Input Parameter:
1883: +  da - initial distributed array
1884: .  ctype - DA_Q1 and DA_Q0 are currently the only supported forms

1886:    Level: intermediate

1888: .keywords:  distributed array, interpolation

1890: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy(), DA, DAInterpolationType
1891: @*/
1892: int DASetInterpolationType(DA da,DAInterpolationType ctype)
1893: {
1896:   da->interptype = ctype;
1897:   return(0);
1898: }