Actual source code: da2.c

  1: /*$Id: da2.c,v 1.164 2001/04/10 19:37:23 bsmith Exp $*/
  2: 
  3: #include "src/dm/da/daimpl.h"    /*I   "petscda.h"   I*/

  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,VEC_SEQ,&isseq);
123:   PetscTypeCompare((PetscObject)vec,VEC_MPI,&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)
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:   Scalar  *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(Scalar));
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
241: .  -da_grid_y <ny> - number of grid points in y direction
242: -  -da_noao - do not compute natural to PETSc ordering object

244:    Level: beginner

246:    Notes:
247:    The stencil type DA_STENCIL_STAR with width 1 corresponds to the 
248:    standard 5-pt stencil, while DA_STENCIL_BOX with width 1 denotes
249:    the standard 9-pt stencil.

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

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

257: .seealso: DADestroy(), DAView(), DACreate1d(), DACreate3d(), DAGlobalToLocalBegin(),
258:           DAGlobalToLocalEnd(), DALocalToGlobal(), DALocalToLocalBegin(), DALocalToLocalEnd(),
259:           DAGetInfo(), DACreateGlobalVector(), DACreateLocalVector(), DACreateNaturalVector(), DALoad(), DAView()

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

278:   *inra = 0;

280:   if (dof < 1) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Must have 1 or more degrees of freedom per node: %d",dof);
281:   if (s < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Stencil width cannot be negative: %d",s);
282:   if (M < 1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Must have M positive");
283:   if (N < 1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Must have N positive");

285:   PetscOptionsBegin(comm,PETSC_NULL,"2d DA Options","DA");
286:     PetscOptionsInt("-da_grid_x","Number of grid points in x direction","DACreate2d",M,&M,PETSC_NULL);
287:     PetscOptionsInt("-da_grid_y","Number of grid points in y direction","DACreate2d",N,&N,PETSC_NULL);
288:     PetscOptionsInt("-da_processors_x","Number of processors in x direction","DACreate2d",m,&m,PETSC_NULL);
289:     PetscOptionsInt("-da_processors_y","Number of processors in y direction","DACreate2d",n,&n,PETSC_NULL);
290:   PetscOptionsEnd();

292:   PetscHeaderCreate(da,_p_DA,struct _DAOps,DA_COOKIE,0,"DA",comm,DADestroy,DAView);
293:   PetscLogObjectCreate(da);
294:   da->bops->publish           = DAPublish_Petsc;
295:   da->ops->createglobalvector = DACreateGlobalVector;
296:   da->ops->getinterpolation   = DAGetInterpolation;
297:   da->ops->getcoloring        = DAGetColoring;
298:   da->ops->refine             = DARefine;
299:   PetscLogObjectMemory(da,sizeof(struct _p_DA));
300:   da->dim        = 2;
301:   da->gtog1      = 0;
302:   PetscMalloc(dof*sizeof(char*),&da->fieldname);
303:   PetscMemzero(da->fieldname,dof*sizeof(char*));

305:   MPI_Comm_size(comm,&size);
306:   MPI_Comm_rank(comm,&rank);

308:   if (m != PETSC_DECIDE) {
309:     if (m < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %d",m);}
310:     else if (m > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %d %d",m,size);}
311:   }
312:   if (n != PETSC_DECIDE) {
313:     if (n < 1) {SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %d",n);}
314:     else if (n > size) {SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %d %d",n,size);}
315:   }

317:   if (m == PETSC_DECIDE || n == PETSC_DECIDE) {
318:     /* try for squarish distribution */
319:     /* This should use MPI_Dims_create instead */
320:     m = (int)(0.5 + sqrt(((double)M)*((double)size)/((double)N)));
321:     if (!m) m = 1;
322:     while (m > 0) {
323:       n = size/m;
324:       if (m*n == size) break;
325:       m--;
326:     }
327:     if (M > N && m < n) {int _m = m; m = n; n = _m;}
328:     if (m*n != size) SETERRQ(PETSC_ERR_PLIB,"Internally Created Bad Partition");
329:   } else if (m*n != size) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition");

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

334:   /*
335:      We should create an MPI Cartesian topology here, with reorder
336:      set to true.  That would create a NEW communicator that we would
337:      need to use for operations on this distributed array 
338:   */
339:   PetscOptionsHasName(PETSC_NULL,"-da_partition_nodes_at_end",&flg2);

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

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

411:   xe = xs + x;
412:   ye = ys + y;

414:   /* determine ghost region */
415:   /* Assume No Periodicity */
416:   if (xs-s > 0) Xs = xs - s; else Xs = 0;
417:   if (ys-s > 0) Ys = ys - s; else Ys = 0;
418:   if (xe+s <= M) Xe = xe + s; else Xe = M;
419:   if (ye+s <= N) Ye = ye + s; else Ye = N;

421:   /* X Periodic */
422:   if (DAXPeriodic(wrap)){
423:     Xs = xs - s;
424:     Xe = xe + s;
425:   }

427:   /* Y Periodic */
428:   if (DAYPeriodic(wrap)){
429:     Ys = ys - s;
430:     Ye = ye + s;
431:   }

433:   /* Resize all X parameters to reflect w */
434:   x   *= dof;
435:   xs  *= dof;
436:   xe  *= dof;
437:   Xs  *= dof;
438:   Xe  *= dof;
439:   s_x = s*dof;
440:   s_y = s;

442:   /* determine starting point of each processor */
443:   nn = x*y;
444:   PetscMalloc((2*size+1)*sizeof(int),&bases);
445:   ldims = (int*)(bases+size+1);
446:   MPI_Allgather(&nn,1,MPI_INT,ldims,1,MPI_INT,comm);
447:   bases[0] = 0;
448:   for (i=1; i<=size; i++) {
449:     bases[i] = ldims[i-1];
450:   }
451:   for (i=1; i<=size; i++) {
452:     bases[i] += bases[i-1];
453:   }

455:   /* allocate the base parallel and sequential vectors */
456:   VecCreateMPI(comm,x*y,PETSC_DECIDE,&global);
457:   VecSetBlockSize(global,dof);
458:   VecCreateSeq(PETSC_COMM_SELF,(Xe-Xs)*(Ye-Ys),&local);
459:   VecSetBlockSize(local,dof);


462:   /* generate appropriate vector scatters */
463:   /* local to global inserts non-ghost point region into global */
464:   VecGetOwnershipRange(global,&start,&end);
465:   ISCreateStride(comm,x*y,start,1,&to);

467:   left  = xs - Xs; down  = ys - Ys; up    = down + y;
468:   PetscMalloc(x*(up - down)*sizeof(int),&idx);
469:   count = 0;
470:   for (i=down; i<up; i++) {
471:     for (j=0; j<x; j++) {
472:       idx[count++] = left + i*(Xe-Xs) + j;
473:     }
474:   }
475:   ISCreateGeneral(comm,count,idx,&from);
476:   PetscFree(idx);

478:   VecScatterCreate(local,from,global,to,&ltog);
479:   PetscLogObjectParent(da,to);
480:   PetscLogObjectParent(da,from);
481:   PetscLogObjectParent(da,ltog);
482:   ISDestroy(from);
483:   ISDestroy(to);

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


526:   /* determine who lies on each side of use stored in    n6 n7 n8
527:                                                          n3    n5
528:                                                          n0 n1 n2
529:   */

531:   /* Assume the Non-Periodic Case */
532:   n1 = rank - m;
533:   if (rank % m) {
534:     n0 = n1 - 1;
535:   } else {
536:     n0 = -1;
537:   }
538:   if ((rank+1) % m) {
539:     n2 = n1 + 1;
540:     n5 = rank + 1;
541:     n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
542:   } else {
543:     n2 = -1; n5 = -1; n8 = -1;
544:   }
545:   if (rank % m) {
546:     n3 = rank - 1;
547:     n6 = n3 + m; if (n6 >= m*n) n6 = -1;
548:   } else {
549:     n3 = -1; n6 = -1;
550:   }
551:   n7 = rank + m; if (n7 >= m*n) n7 = -1;


554:   /* Modify for Periodic Cases */
555:   if (wrap == DA_YPERIODIC) {  /* Handle Top and Bottom Sides */
556:     if (n1 < 0) n1 = rank + m * (n-1);
557:     if (n7 < 0) n7 = rank - m * (n-1);
558:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
559:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
560:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
561:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
562:   } else if (wrap == DA_XPERIODIC) { /* Handle Left and Right Sides */
563:     if (n3 < 0) n3 = rank + (m-1);
564:     if (n5 < 0) n5 = rank - (m-1);
565:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
566:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
567:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
568:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
569:   } else if (wrap == DA_XYPERIODIC) {

571:     /* Handle all four corners */
572:     if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
573:     if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
574:     if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
575:     if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;

577:     /* Handle Top and Bottom Sides */
578:     if (n1 < 0) n1 = rank + m * (n-1);
579:     if (n7 < 0) n7 = rank - m * (n-1);
580:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
581:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
582:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
583:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;

585:     /* Handle Left and Right Sides */
586:     if (n3 < 0) n3 = rank + (m-1);
587:     if (n5 < 0) n5 = rank - (m-1);
588:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
589:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
590:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
591:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
592:   }

594:   if (stencil_type == DA_STENCIL_STAR) {
595:     /* save corner processor numbers */
596:     sn0 = n0; sn2 = n2; sn6 = n6; sn8 = n8;
597:     n0 = n2 = n6 = n8 = -1;
598:   }

600:   PetscMalloc((x+2*s_x)*(y+2*s_y)*sizeof(int),&idx);
601:   PetscLogObjectMemory(da,(x+2*s_x)*(y+2*s_y)*sizeof(int));
602:   nn = 0;

604:   xbase = bases[rank];
605:   for (i=1; i<=s_y; i++) {
606:     if (n0 >= 0) { /* left below */
607:       x_t = lx[n0 % m]*dof;
608:       y_t = ly[(n0/m)];
609:       s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
610:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
611:     }
612:     if (n1 >= 0) { /* directly below */
613:       x_t = x;
614:       y_t = ly[(n1/m)];
615:       s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
616:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
617:     }
618:     if (n2 >= 0) { /* right below */
619:       x_t = lx[n2 % m]*dof;
620:       y_t = ly[(n2/m)];
621:       s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
622:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
623:     }
624:   }

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

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

636:     if (n5 >= 0) { /* directly right */
637:       x_t = lx[n5 % m]*dof;
638:       /* y_t = y; */
639:       s_t = bases[n5] + (i)*x_t;
640:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
641:     }
642:   }

644:   for (i=1; i<=s_y; i++) {
645:     if (n6 >= 0) { /* left above */
646:       x_t = lx[n6 % m]*dof;
647:       /* y_t = ly[(n6/m)]; */
648:       s_t = bases[n6] + (i)*x_t - s_x;
649:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
650:     }
651:     if (n7 >= 0) { /* directly above */
652:       x_t = x;
653:       /* y_t = ly[(n7/m)]; */
654:       s_t = bases[n7] + (i-1)*x_t;
655:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
656:     }
657:     if (n8 >= 0) { /* right above */
658:       x_t = lx[n8 % m]*dof;
659:       /* y_t = ly[(n8/m)]; */
660:       s_t = bases[n8] + (i-1)*x_t;
661:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
662:     }
663:   }

665:   base = bases[rank];
666:   ISCreateGeneral(comm,nn,idx,&from);
667:   VecScatterCreate(global,from,local,to,&gtol);
668:   PetscLogObjectParent(da,to);
669:   PetscLogObjectParent(da,from);
670:   PetscLogObjectParent(da,gtol);
671:   ISDestroy(to);
672:   ISDestroy(from);

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

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

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

713:       if (n5 >= 0) { /* directly right */
714:         x_t = lx[n5 % m]*dof;
715:         /* y_t = y; */
716:         s_t = bases[n5] + (i)*x_t;
717:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
718:       }
719:     }

721:     for (i=1; i<=s_y; i++) {
722:       if (n6 >= 0) { /* left above */
723:         x_t = lx[n6 % m]*dof;
724:         /* y_t = ly[(n6/m)]; */
725:         s_t = bases[n6] + (i)*x_t - s_x;
726:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
727:       }
728:       if (n7 >= 0) { /* directly above */
729:         x_t = x;
730:         /* y_t = ly[(n7/m)]; */
731:         s_t = bases[n7] + (i-1)*x_t;
732:         for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
733:       }
734:       if (n8 >= 0) { /* right above */
735:         x_t = lx[n8 % m]*dof;
736:         /* y_t = ly[(n8/m)]; */
737:         s_t = bases[n8] + (i-1)*x_t;
738:         for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
739:       }
740:     }
741:   }

743:   da->M  = M;  da->N  = N;  da->m  = m;  da->n  = n;  da->w = dof;  da->s = s;
744:   da->xs = xs; da->xe = xe; da->ys = ys; da->ye = ye; da->zs = 0; da->ze = 1;
745:   da->Xs = Xs; da->Xe = Xe; da->Ys = Ys; da->Ye = Ye; da->Zs = 0; da->Ze = 1;
746:   da->P  = 1;  da->p  = 1;

748:   PetscLogObjectParent(da,global);
749:   PetscLogObjectParent(da,local);

751:   da->global       = global;
752:   da->local        = local;
753:   da->gtol         = gtol;
754:   da->ltog         = ltog;
755:   da->idx          = idx;
756:   da->Nl           = nn;
757:   da->base         = base;
758:   da->wrap         = wrap;
759:   da->ops->view    = DAView_2d;
760:   da->stencil_type = stencil_type;

762:   /* 
763:      Set the local to global ordering in the global vector, this allows use
764:      of VecSetValuesLocal().
765:   */
766:   ISLocalToGlobalMappingCreate(comm,nn,idx,&da->ltogmap);
767:   VecSetLocalToGlobalMapping(da->global,da->ltogmap);
768:   ISLocalToGlobalMappingBlock(da->ltogmap,da->w,&da->ltogmapb);
769:   VecSetLocalToGlobalMappingBlock(da->global,da->ltogmapb);
770:   PetscLogObjectParent(da,da->ltogmap);

772:   *inra = da;

774:   /* recalculate the idx including missed ghost points */
775:   /* Assume the Non-Periodic Case */
776:   n1 = rank - m;
777:   if (rank % m) {
778:     n0 = n1 - 1;
779:   } else {
780:     n0 = -1;
781:   }
782:   if ((rank+1) % m) {
783:     n2 = n1 + 1;
784:     n5 = rank + 1;
785:     n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
786:   } else {
787:     n2 = -1; n5 = -1; n8 = -1;
788:   }
789:   if (rank % m) {
790:     n3 = rank - 1;
791:     n6 = n3 + m; if (n6 >= m*n) n6 = -1;
792:   } else {
793:     n3 = -1; n6 = -1;
794:   }
795:   n7 = rank + m; if (n7 >= m*n) n7 = -1;


798:   /* Modify for Periodic Cases */
799:   if (wrap == DA_YPERIODIC) {  /* Handle Top and Bottom Sides */
800:     if (n1 < 0) n1 = rank + m * (n-1);
801:     if (n7 < 0) n7 = rank - m * (n-1);
802:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
803:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
804:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
805:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
806:   } else if (wrap == DA_XPERIODIC) { /* Handle Left and Right Sides */
807:     if (n3 < 0) n3 = rank + (m-1);
808:     if (n5 < 0) n5 = rank - (m-1);
809:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
810:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
811:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
812:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
813:   } else if (wrap == DA_XYPERIODIC) {

815:     /* Handle all four corners */
816:     if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
817:     if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
818:     if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
819:     if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;

821:     /* Handle Top and Bottom Sides */
822:     if (n1 < 0) n1 = rank + m * (n-1);
823:     if (n7 < 0) n7 = rank - m * (n-1);
824:     if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
825:     if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
826:     if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
827:     if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;

829:     /* Handle Left and Right Sides */
830:     if (n3 < 0) n3 = rank + (m-1);
831:     if (n5 < 0) n5 = rank - (m-1);
832:     if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
833:     if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
834:     if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
835:     if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
836:   }

838:   nn = 0;

840:   xbase = bases[rank];
841:   for (i=1; i<=s_y; i++) {
842:     if (n0 >= 0) { /* left below */
843:       x_t = lx[n0 % m]*dof;
844:       y_t = ly[(n0/m)];
845:       s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
846:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
847:     }
848:     if (n1 >= 0) { /* directly below */
849:       x_t = x;
850:       y_t = ly[(n1/m)];
851:       s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
852:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
853:     }
854:     if (n2 >= 0) { /* right below */
855:       x_t = lx[n2 % m]*dof;
856:       y_t = ly[(n2/m)];
857:       s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
858:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
859:     }
860:   }

862:   for (i=0; i<y; i++) {
863:     if (n3 >= 0) { /* directly left */
864:       x_t = lx[n3 % m]*dof;
865:       /* y_t = y; */
866:       s_t = bases[n3] + (i+1)*x_t - s_x;
867:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
868:     }

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

872:     if (n5 >= 0) { /* directly right */
873:       x_t = lx[n5 % m]*dof;
874:       /* y_t = y; */
875:       s_t = bases[n5] + (i)*x_t;
876:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
877:     }
878:   }

880:   for (i=1; i<=s_y; i++) {
881:     if (n6 >= 0) { /* left above */
882:       x_t = lx[n6 % m]*dof;
883:       /* y_t = ly[(n6/m)]; */
884:       s_t = bases[n6] + (i)*x_t - s_x;
885:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
886:     }
887:     if (n7 >= 0) { /* directly above */
888:       x_t = x;
889:       /* y_t = ly[(n7/m)]; */
890:       s_t = bases[n7] + (i-1)*x_t;
891:       for (j=0; j<x_t; j++) { idx[nn++] = s_t++;}
892:     }
893:     if (n8 >= 0) { /* right above */
894:       x_t = lx[n8 % m]*dof;
895:       /* y_t = ly[(n8/m)]; */
896:       s_t = bases[n8] + (i-1)*x_t;
897:       for (j=0; j<s_x; j++) { idx[nn++] = s_t++;}
898:     }
899:   }
900:   /* keep bases for use at end of routine */
901:   /* PetscFree(bases); */

903:   /* construct the local to local scatter context */
904:   /* 
905:       We simply remap the values in the from part of 
906:     global to local to read from an array with the ghost values 
907:     rather then from the plan array.
908:   */
909:   VecScatterCopy(gtol,&da->ltol);
910:   PetscLogObjectParent(da,da->ltol);
911:   left  = xs - Xs; down  = ys - Ys; up    = down + y;
912:   PetscMalloc(x*(up - down)*sizeof(int),&idx);
913:   count = 0;
914:   for (i=down; i<up; i++) {
915:     for (j=0; j<x; j++) {
916:       idx[count++] = left + i*(Xe-Xs) + j;
917:     }
918:   }
919:   VecScatterRemap(da->ltol,idx,PETSC_NULL);
920:   PetscFree(idx);

922:   /* 
923:      Build the natural ordering to PETSc ordering mappings.
924:   */
925:   PetscOptionsHasName(PETSC_NULL,"-da_noao",&flg1);
926:   if (!flg1) {
927:     IS  ispetsc,isnatural;
928:     int *lidx,lict = 0,Nlocal = (da->xe-da->xs)*(da->ye-da->ys);

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

932:     PetscMalloc(Nlocal*sizeof(int),&lidx);
933:     for (j=ys; j<ye; j++) {
934:       for (i=xs; i<xe; i++) {
935:         /*  global number in natural ordering */
936:         lidx[lict++] = i + j*M*dof;
937:       }
938:     }
939:     ISCreateGeneral(comm,Nlocal,lidx,&isnatural);
940:     PetscFree(lidx);


943:     AOCreateBasicIS(isnatural,ispetsc,&da->ao);
944:     PetscLogObjectParent(da,da->ao);
945:     ISDestroy(ispetsc);
946:     ISDestroy(isnatural);
947:   } else {
948:     da->ao = PETSC_NULL;
949:   }

951:   if (!flx) {
952:     PetscMalloc(m*sizeof(int),&flx);
953:     PetscMemcpy(flx,lx,m*sizeof(int));
954:   }
955:   if (!fly) {
956:     PetscMalloc(n*sizeof(int),&fly);
957:     PetscMemcpy(fly,ly,n*sizeof(int));
958:   }
959:   da->lx = flx;
960:   da->ly = fly;

962:   /*
963:      Note the following will be removed soon. Since the functionality 
964:     is replaced by the above.
965:   */
966:   /* Construct the mapping from current global ordering to global
967:      ordering that would be used if only 1 processor were employed.
968:      This mapping is intended only for internal use by discrete
969:      function and matrix viewers.

971:      Note: At this point, x has already been adjusted for multiple
972:      degrees of freedom per node.
973:    */
974:   ldim = x*y;
975:   VecGetSize(global,&gdim);
976:   PetscMalloc(gdim*sizeof(int),&da->gtog1);
977:   PetscLogObjectMemory(da,gdim*sizeof(int));
978:   PetscMalloc((2*(gdim+ldim))*sizeof(int),&gA);
979:   gB        = (int *)(gA + ldim);
980:   gAall     = (int *)(gB + ldim);
981:   gBall     = (int *)(gAall + gdim);

983:   /* Compute local parts of global orderings */
984:   ict = 0;
985:   for (j=ys; j<ye; j++) {
986:     for (i=xs; i<xe; i++) {
987:       /* gA = global number for 1 proc; gB = current global number */
988:       gA[ict] = i + j*M*dof;
989:       gB[ict] = start + ict;
990:       ict++;
991:     }
992:   }
993:   /* Broadcast the orderings */
994:   MPI_Allgatherv(gA,ldim,MPI_INT,gAall,ldims,bases,MPI_INT,comm);
995:   MPI_Allgatherv(gB,ldim,MPI_INT,gBall,ldims,bases,MPI_INT,comm);
996:   for (i=0; i<gdim; i++) da->gtog1[gBall[i]] = gAall[i];
997:   PetscFree(gA);
998:   PetscFree(bases);

1000:   PetscOptionsHasName(PETSC_NULL,"-da_view",&flg1);
1001:   if (flg1) {DAView(da,PETSC_VIEWER_STDOUT_(da->comm));}
1002:   PetscOptionsHasName(PETSC_NULL,"-da_view_draw",&flg1);
1003:   if (flg1) {DAView(da,PETSC_VIEWER_DRAW_(da->comm));}
1004:   PetscOptionsHasName(PETSC_NULL,"-help",&flg1);
1005:   if (flg1) {DAPrintHelp(da);}

1007:   PetscPublishAll(da);
1008: #if defined(PETSC_HAVE_AMS)
1009:   PetscObjectComposeFunctionDynamic((PetscObject)global,"AMSSetFieldBlock_C",
1010:          "AMSSetFieldBlock_DA",AMSSetFieldBlock_DA);
1011:   PetscObjectComposeFunctionDynamic((PetscObject)local,"AMSSetFieldBlock_C",
1012:          "AMSSetFieldBlock_DA",AMSSetFieldBlock_DA);
1013:   if (((PetscObject)global)->amem > -1) {
1014:     AMSSetFieldBlock_DA(((PetscObject)global)->amem,"values",global);
1015:   }
1016: #endif
1017: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX)
1018:   if (dof == 1) {
1019:     PetscObjectComposeFunctionDynamic((PetscObject)local,"PetscMatlabEnginePut_C","VecMatlabEnginePut_DA2d",VecMatlabEnginePut_DA2d);
1020:   }
1021: #endif
1022:   VecSetOperation(global,VECOP_VIEW,(void(*)())VecView_MPI_DA);
1023:   VecSetOperation(global,VECOP_LOADINTOVECTOR,(void(*)())VecLoadIntoVector_Binary_DA);
1024:   return(0);
1025: }

1027: /*@
1028:    DAPrintHelp - Prints command line options for DA.

1030:    Collective on DA

1032:    Input Parameters:
1033: .  da - the distributed array

1035:    Level: intermediate

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

1039: .keywords: DA, help

1041: @*/
1042: int DAPrintHelp(DA da)
1043: {
1044:   static PetscTruth called = PETSC_FALSE;
1045:   MPI_Comm          comm;
1046:   int               ierr;


1051:   comm = da->comm;
1052:   if (!called) {
1053:     (*PetscHelpPrintf)(comm,"General Distributed Array (DA) options:n");
1054:     (*PetscHelpPrintf)(comm,"  -da_view: print DA distribution to screenn");
1055:     (*PetscHelpPrintf)(comm,"  -da_view_draw: display DA in windown");
1056:     called = PETSC_TRUE;
1057:   }
1058:   return(0);
1059: }

1061: /*@C
1062:    DARefine - Creates a new distributed array that is a refinement of a given
1063:    distributed array.

1065:    Collective on DA

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

1072:    Output Parameter:
1073: .  daref - refined distributed array

1075:    Level: advanced

1077:    Note:
1078:    Currently, refinement consists of just doubling the number of grid spaces
1079:    in each dimension of the DA.

1081: .keywords:  distributed array, refine

1083: .seealso: DACreate1d(), DACreate2d(), DACreate3d(), DADestroy()
1084: @*/
1085: int DARefine(DA da,MPI_Comm comm,DA *daref)
1086: {
1087:   int M,N,P,ierr;
1088:   DA  da2;


1093:   if (DAXPeriodic(da->wrap)){
1094:     M = 2*da->M;
1095:   } else {
1096:     M = 2*da->M - 1;
1097:   }
1098:   if (DAYPeriodic(da->wrap)){
1099:     N = 2*da->N;
1100:   } else {
1101:     N = 2*da->N - 1;
1102:   }
1103:   if (DAZPeriodic(da->wrap)){
1104:     P = 2*da->P;
1105:   } else {
1106:     P = 2*da->P - 1;
1107:   }
1108:   if (da->dim == 1) {
1109:     DACreate1d(da->comm,da->wrap,M,da->w,da->s,PETSC_NULL,&da2);
1110:   } else if (da->dim == 2) {
1111:     DACreate2d(da->comm,da->wrap,da->stencil_type,M,N,da->m,da->n,da->w,da->s,PETSC_NULL,PETSC_NULL,&da2);
1112:   } else if (da->dim == 3) {
1113:     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);
1114:   }
1115:   *daref = da2;
1116:   return(0);
1117: }

1119: /*
1120:       M is number of grid points 
1121:       m is number of processors

1123: */
1124: int DASplitComm2d(MPI_Comm comm,int M,int N,int sw,MPI_Comm *outcomm)
1125: {
1126:   int ierr,m,n = 0,csize,size,rank,x = 0,y = 0;

1129:   MPI_Comm_size(comm,&size);
1130:   MPI_Comm_rank(comm,&rank);

1132:   csize = 4*size;
1133:   do {
1134:     if (csize % 4) SETERRQ4(1,"Cannot split communicator of size %d tried %d %d %d",size,csize,x,y);
1135:     csize   = csize/4;
1136: 
1137:     m = (int)(0.5 + sqrt(((double)M)*((double)csize)/((double)N)));
1138:     if (!m) m = 1;
1139:     while (m > 0) {
1140:       n = csize/m;
1141:       if (m*n == csize) break;
1142:       m--;
1143:     }
1144:     if (M > N && m < n) {int _m = m; m = n; n = _m;}

1146:     x = M/m + ((M % m) > ((csize-1) % m));
1147:     y = (N + (csize-1)/m)/n;
1148:   } while ((x < 4 || y < 4) && csize > 1);
1149:   if (size != csize) {
1150:     MPI_Group entire_group,sub_group;
1151:     int       i,*groupies;

1153:     ierr     = MPI_Comm_group(comm,&entire_group);
1154:     PetscMalloc(csize*sizeof(int),&groupies);
1155:     for (i=0; i<csize; i++) {
1156:       groupies[i] = (rank/csize)*csize + i;
1157:     }
1158:     ierr     = MPI_Group_incl(entire_group,csize,groupies,&sub_group);
1159:     ierr     = PetscFree(groupies);
1160:     ierr     = MPI_Comm_create(comm,sub_group,outcomm);
1161:     ierr     = MPI_Group_free(&entire_group);
1162:     ierr     = MPI_Group_free(&sub_group);
1163:     PetscLogInfo(0,"Creating redundant coarse problems of size %dn",csize);
1164:   } else {
1165:     *outcomm = comm;
1166:   }
1167:   return(0);
1168: }