Actual source code: damg.c

  1: /*$Id: damg.c,v 1.35 2001/07/20 21:25:12 bsmith Exp $*/
  2: 
 3:  #include petscda.h
 4:  #include petscksp.h
 5:  #include petscmg.h

  7: /*
  8:    Code for almost fully managing multigrid/multi-level linear solvers for DA grids
  9: */

 13: /*@C
 14:     DMMGCreate - Creates a DA based multigrid solver object. This allows one to 
 15:       easily implement MG methods on regular grids.

 17:     Collective on MPI_Comm

 19:     Input Parameter:
 20: +   comm - the processors that will share the grids and solution process
 21: .   nlevels - number of multigrid levels 
 22: -   user - an optional user context

 24:     Output Parameters:
 25: .    - the context

 27:     Notes:
 28:       To provide a different user context for each level call DMMGSetUser() after calling
 29:       this routine

 31:     Level: advanced

 33: .seealso DMMGDestroy() 

 35: @*/
 36: int DMMGCreate(MPI_Comm comm,int nlevels,void *user,DMMG **dmmg)
 37: {
 38:   int        ierr,i;
 39:   DMMG       *p;
 40:   PetscTruth galerkin;

 43:   PetscOptionsGetInt(0,"-dmmg_nlevels",&nlevels,PETSC_IGNORE);
 44:   PetscOptionsHasName(0,"-dmmg_galerkin",&galerkin);

 46:   PetscMalloc(nlevels*sizeof(DMMG),&p);
 47:   for (i=0; i<nlevels; i++) {
 48:     PetscNew(struct _p_DMMG,&p[i]);
 49:     PetscMemzero(p[i],sizeof(struct _p_DMMG));
 50:     p[i]->nlevels  = nlevels - i;
 51:     p[i]->comm     = comm;
 52:     p[i]->user     = user;
 53:     p[i]->galerkin = galerkin;
 54:   }
 55:   *dmmg = p;
 56:   return(0);
 57: }

 61: /*@C
 62:     DMMGSetUseGalerkinCoarse - Courses the DMMG to use R*A_f*R^T to form
 63:        the coarser matrices from finest 

 65:     Collective on DMMG

 67:     Input Parameter:
 68: .    - the context

 70:     Options Database Keys:
 71: .    -dmmg_galerkin

 73:     Level: advanced

 75: .seealso DMMGCreate()

 77: @*/
 78: int DMMGSetUseGalerkinCoarse(DMMG* dmmg)
 79: {
 80:   int  i,nlevels = dmmg[0]->nlevels;

 83:   if (!dmmg) SETERRQ(1,"Passing null as DMMG");

 85:   for (i=0; i<nlevels; i++) {
 86:     dmmg[i]->galerkin = PETSC_TRUE;
 87:   }
 88:   return(0);
 89: }

 93: /*@C
 94:     DMMGDestroy - Destroys a DA based multigrid solver object. 

 96:     Collective on DMMG

 98:     Input Parameter:
 99: .    - the context

101:     Level: advanced

103: .seealso DMMGCreate()

105: @*/
106: int DMMGDestroy(DMMG *dmmg)
107: {
108:   int     ierr,i,nlevels = dmmg[0]->nlevels;

111:   if (!dmmg) SETERRQ(1,"Passing null as DMMG");

113:   for (i=1; i<nlevels; i++) {
114:     if (dmmg[i]->R) {MatDestroy(dmmg[i]->R);}
115:   }
116:   for (i=0; i<nlevels; i++) {
117:     if (dmmg[i]->dm)      {DMDestroy(dmmg[i]->dm);}
118:     if (dmmg[i]->x)       {VecDestroy(dmmg[i]->x);}
119:     if (dmmg[i]->b)       {VecDestroy(dmmg[i]->b);}
120:     if (dmmg[i]->r)       {VecDestroy(dmmg[i]->r);}
121:     if (dmmg[i]->work1)   {VecDestroy(dmmg[i]->work1);}
122:     if (dmmg[i]->w)       {VecDestroy(dmmg[i]->w);}
123:     if (dmmg[i]->work2)   {VecDestroy(dmmg[i]->work2);}
124:     if (dmmg[i]->lwork1)  {VecDestroy(dmmg[i]->lwork1);}
125:     if (dmmg[i]->B && dmmg[i]->B != dmmg[i]->J) {MatDestroy(dmmg[i]->B);}
126:     if (dmmg[i]->J)         {MatDestroy(dmmg[i]->J);}
127:     if (dmmg[i]->Rscale)    {VecDestroy(dmmg[i]->Rscale);}
128:     if (dmmg[i]->fdcoloring){MatFDColoringDestroy(dmmg[i]->fdcoloring);}
129:     if (dmmg[i]->ksp)      {KSPDestroy(dmmg[i]->ksp);}
130:     if (dmmg[i]->snes)      {PetscObjectDestroy((PetscObject)dmmg[i]->snes);}
131:     if (dmmg[i]->inject)    {VecScatterDestroy(dmmg[i]->inject);}
132:     PetscFree(dmmg[i]);
133:   }
134:   PetscFree(dmmg);
135:   return(0);
136: }

140: /*@C
141:     DMMGSetDM - Sets the coarse grid information for the grids

143:     Collective on DMMG

145:     Input Parameter:
146: +   dmmg - the context
147: -   dm - the DA or VecPack object

149:     Level: advanced

151: .seealso DMMGCreate(), DMMGDestroy()

153: @*/
154: int DMMGSetDM(DMMG *dmmg,DM dm)
155: {
156:   int        ierr,i,nlevels = dmmg[0]->nlevels;

159:   if (!dmmg) SETERRQ(1,"Passing null as DMMG");

161:   /* Create DA data structure for all the levels */
162:   dmmg[0]->dm = dm;
163:   PetscObjectReference((PetscObject)dm);
164:   for (i=1; i<nlevels; i++) {
165:     DMRefine(dmmg[i-1]->dm,dmmg[i]->comm,&dmmg[i]->dm);
166:   }
167:   DMMGSetUp(dmmg);
168:   return(0);
169: }

173: /*@C
174:     DMMGSetUp - Prepares the DMMG to solve a system

176:     Collective on DMMG

178:     Input Parameter:
179: .   dmmg - the context

181:     Level: advanced

183: .seealso DMMGCreate(), DMMGDestroy(), DMMG, DMMGSetSNES(), DMMGSetKSP(), DMMGSolve()

185: @*/
186: int DMMGSetUp(DMMG *dmmg)
187: {
188:   int        ierr,i,nlevels = dmmg[0]->nlevels;


192:   /* Create work vectors and matrix for each level */
193:   for (i=0; i<nlevels; i++) {
194:     DMCreateGlobalVector(dmmg[i]->dm,&dmmg[i]->x);
195:     VecDuplicate(dmmg[i]->x,&dmmg[i]->b);
196:     VecDuplicate(dmmg[i]->x,&dmmg[i]->r);
197:   }

199:   /* Create interpolation/restriction between levels */
200:   for (i=1; i<nlevels; i++) {
201:     DMGetInterpolation(dmmg[i-1]->dm,dmmg[i]->dm,&dmmg[i]->R,PETSC_NULL);
202:   }

204:   return(0);
205: }

209: /*@C
210:     DMMGSolve - Actually solves the (non)linear system defined with the DMMG

212:     Collective on DMMG

214:     Input Parameter:
215: .   dmmg - the context

217:     Level: advanced

219:     Options Database:
220: +   -dmmg_grid_sequence - use grid sequencing to get the initial solution for each level from the previous
221: -   -dmmg_vecmonitor - display the solution at each iteration

223:      Notes: For linear (KSP) problems may be called more than once, uses the same 
224:     matrices but recomputes the right hand side for each new solve. Call DMMGSetKSP()
225:     to generate new matrices.
226:  
227: .seealso DMMGCreate(), DMMGDestroy(), DMMG, DMMGSetSNES(), DMMGSetKSP(), DMMGSetUp()

229: @*/
230: int DMMGSolve(DMMG *dmmg)
231: {
232:   int        i,ierr,nlevels = dmmg[0]->nlevels;
233:   PetscTruth gridseq,vecmonitor,flg;

236:   PetscOptionsHasName(0,"-dmmg_grid_sequence",&gridseq);
237:   PetscOptionsHasName(0,"-dmmg_vecmonitor",&vecmonitor);
238:   if (gridseq) {
239:     if (dmmg[0]->initialguess) {
240:       (*dmmg[0]->initialguess)(dmmg[0]->snes,dmmg[0]->x,dmmg[0]);
241:       if (dmmg[0]->ksp) {
242:         KSPSetInitialGuessNonzero(dmmg[0]->ksp,PETSC_TRUE);
243:       }
244:     }
245:     for (i=0; i<nlevels-1; i++) {
246:       (*dmmg[i]->solve)(dmmg,i);
247:       if (vecmonitor) {
248:         VecView(dmmg[i]->x,PETSC_VIEWER_DRAW_(dmmg[i]->comm));
249:       }
250:       MatInterpolate(dmmg[i+1]->R,dmmg[i]->x,dmmg[i+1]->x);
251:       if (dmmg[i+1]->ksp) {
252:         KSPSetInitialGuessNonzero(dmmg[i+1]->ksp,PETSC_TRUE);
253:       }
254:     }
255:   } else {
256:     if (dmmg[nlevels-1]->initialguess) {
257:       (*dmmg[nlevels-1]->initialguess)(dmmg[nlevels-1]->snes,dmmg[nlevels-1]->x,dmmg[nlevels-1]);
258:       if (dmmg[nlevels-1]->ksp) {
259:         KSPSetInitialGuessNonzero(dmmg[nlevels-1]->ksp,PETSC_TRUE);
260:       }
261:     }
262:   }
263:   (*DMMGGetFine(dmmg)->solve)(dmmg,nlevels-1);
264:   if (vecmonitor) {
265:      VecView(dmmg[nlevels-1]->x,PETSC_VIEWER_DRAW_(dmmg[nlevels-1]->comm));
266:   }

268:   PetscOptionsHasName(PETSC_NULL,"-dmmg_view",&flg);
269:   if (flg && !PetscPreLoadingOn) {
270:     DMMGView(dmmg,PETSC_VIEWER_STDOUT_(dmmg[0]->comm));
271:   }
272:   return(0);
273: }

277: int DMMGSolveKSP(DMMG *dmmg,int level)
278: {
279:   int        ierr;

282:   (*dmmg[level]->rhs)(dmmg[level],dmmg[level]->b);
283:   if (dmmg[level]->matricesset) {
284:     KSPSetOperators(dmmg[level]->ksp,dmmg[level]->J,dmmg[level]->J,SAME_NONZERO_PATTERN);
285:     dmmg[level]->matricesset = PETSC_FALSE;
286:   }
287:   KSPSetRhs(dmmg[level]->ksp,dmmg[level]->b);
288:   KSPSetSolution(dmmg[level]->ksp,dmmg[level]->x);
289:   KSPSolve(dmmg[level]->ksp);
290:   return(0);
291: }

293: /*
294:     Sets each of the linear solvers to use multigrid 
295: */
298: int DMMGSetUpLevel(DMMG *dmmg,KSP ksp,int nlevels)
299: {
300:   int         ierr,i;
301:   PC          pc;
302:   PetscTruth  ismg,monitor,ismf,isshell,ismffd;
303:   KSP        lksp; /* solver internal to the multigrid preconditioner */
304:   MPI_Comm    *comms,comm;
305:   PetscViewer ascii;

308:   if (!dmmg) SETERRQ(1,"Passing null as DMMG");

310:   PetscOptionsHasName(PETSC_NULL,"-dmmg_ksp_monitor",&monitor);
311:   if (monitor) {
312:     PetscObjectGetComm((PetscObject)ksp,&comm);
313:     PetscViewerASCIIOpen(comm,"stdout",&ascii);
314:     PetscViewerASCIISetTab(ascii,1+dmmg[0]->nlevels-nlevels);
315:     KSPSetMonitor(ksp,KSPDefaultMonitor,ascii,(int(*)(void*))PetscViewerDestroy);
316:   }

318:   /* use fgmres on outer iteration by default */
319:   KSPSetType(ksp,KSPFGMRES);
320:   KSPGetPC(ksp,&pc);
321:   PCSetType(pc,PCMG);
322:   PetscMalloc(nlevels*sizeof(MPI_Comm),&comms);
323:   for (i=0; i<nlevels; i++) {
324:     comms[i] = dmmg[i]->comm;
325:   }
326:   MGSetLevels(pc,nlevels,comms);
327:   PetscFree(comms);
328:    MGSetType(pc,MGFULL);

330:   PetscTypeCompare((PetscObject)pc,PCMG,&ismg);
331:   if (ismg) {

333:     /* set solvers for each level */
334:     for (i=0; i<nlevels; i++) {
335:       MGGetSmoother(pc,i,&lksp);
336:       KSPSetOperators(lksp,dmmg[i]->J,dmmg[i]->B,DIFFERENT_NONZERO_PATTERN);
337:       MGSetX(pc,i,dmmg[i]->x);
338:       MGSetRhs(pc,i,dmmg[i]->b);
339:       MGSetR(pc,i,dmmg[i]->r);
340:       MGSetResidual(pc,i,MGDefaultResidual,dmmg[i]->J);
341:       if (monitor) {
342:         PetscObjectGetComm((PetscObject)lksp,&comm);
343:         PetscViewerASCIIOpen(comm,"stdout",&ascii);
344:         PetscViewerASCIISetTab(ascii,1+dmmg[0]->nlevels-i);
345:         KSPSetMonitor(lksp,KSPDefaultMonitor,ascii,(int(*)(void*))PetscViewerDestroy);
346:       }
347:       /* If using a matrix free multiply and did not provide an explicit matrix to build
348:          the preconditioner then must use no preconditioner 
349:       */
350:       PetscTypeCompare((PetscObject)dmmg[i]->B,MATSHELL,&isshell);
351:       PetscTypeCompare((PetscObject)dmmg[i]->B,MATDAAD,&ismf);
352:       PetscTypeCompare((PetscObject)dmmg[i]->B,MATMFFD,&ismffd);
353:       if (isshell || ismf || ismffd) {
354:         PC  lpc;
355:         KSPGetPC(lksp,&lpc);
356:         PCSetType(lpc,PCNONE);
357:       }
358:     }

360:     /* Set interpolation/restriction between levels */
361:     for (i=1; i<nlevels; i++) {
362:       MGSetInterpolate(pc,i,dmmg[i]->R);
363:       MGSetRestriction(pc,i,dmmg[i]->R);
364:     }
365:   }
366:   return(0);
367: }

369: extern int MatSeqAIJPtAP(Mat,Mat,Mat*);

373: /*@C
374:     DMMGSetKSP - Sets the linear solver object that will use the grid hierarchy

376:     Collective on DMMG

378:     Input Parameter:
379: +   dmmg - the context
380: .   func - function to compute linear system matrix on each grid level
381: -   rhs - function to compute right hand side on each level (need only work on the finest grid
382:           if you do not use grid sequencing

384:     Level: advanced

386:     Notes: For linear problems my be called more than once, reevaluates the matrices if it is called more
387:        than once. Call DMMGSolve() directly several times to solve with the same matrix but different 
388:        right hand sides.
389:    
390: .seealso DMMGCreate(), DMMGDestroy, DMMGSetDM(), DMMGSolve()

392: @*/
393: int DMMGSetKSP(DMMG *dmmg,int (*rhs)(DMMG,Vec),int (*func)(DMMG,Mat))
394: {
395:   int        ierr,size,i,nlevels = dmmg[0]->nlevels;
396:   PetscTruth galerkin;

399:   if (!dmmg) SETERRQ(1,"Passing null as DMMG");
400:   galerkin = dmmg[0]->galerkin;

402:   if (galerkin) {
403:     MPI_Comm_size(dmmg[nlevels-1]->comm,&size);
404:     DMGetMatrix(dmmg[nlevels-1]->dm,MATAIJ,&dmmg[nlevels-1]->B);
405:     (*func)(dmmg[nlevels-1],dmmg[nlevels-1]->B);
406:     for (i=nlevels-2; i>-1; i--) {
407:       MatSeqAIJPtAP(dmmg[i+1]->B,dmmg[i+1]->R,&dmmg[i]->B);
408:     }
409:   }

411:   if (!dmmg[0]->ksp) {
412:     /* create solvers for each level */
413:     for (i=0; i<nlevels; i++) {

415:       if (!dmmg[i]->B && !galerkin) {
416:         MPI_Comm_size(dmmg[i]->comm,&size);
417:         DMGetMatrix(dmmg[i]->dm,MATAIJ,&dmmg[i]->B);
418:       }
419:       if (!dmmg[i]->J) {
420:         dmmg[i]->J = dmmg[i]->B;
421:       }

423:       KSPCreate(dmmg[i]->comm,&dmmg[i]->ksp);
424:       DMMGSetUpLevel(dmmg,dmmg[i]->ksp,i+1);
425:       KSPSetFromOptions(dmmg[i]->ksp);
426:       dmmg[i]->solve = DMMGSolveKSP;
427:       dmmg[i]->rhs   = rhs;
428:     }
429:   }

431:   /* evalute matrix on each level */
432:   for (i=0; i<nlevels; i++) {
433:     if (!galerkin) {
434:       (*func)(dmmg[i],dmmg[i]->J);
435:     }
436:     dmmg[i]->matricesset = PETSC_TRUE;
437:   }

439:   for (i=0; i<nlevels-1; i++) {
440:     KSPSetOptionsPrefix(dmmg[i]->ksp,"dmmg_");
441:   }

443:   return(0);
444: }

448: /*@C
449:     DMMGView - prints information on a DA based multi-level preconditioner

451:     Collective on DMMG and PetscViewer

453:     Input Parameter:
454: +   dmmg - the context
455: -   viewer - the viewer

457:     Level: advanced

459: .seealso DMMGCreate(), DMMGDestroy

461: @*/
462: int DMMGView(DMMG *dmmg,PetscViewer viewer)
463: {
464:   int            ierr,i,nlevels = dmmg[0]->nlevels,flag;
465:   MPI_Comm       comm;
466:   PetscTruth     isascii;

471:   PetscObjectGetComm((PetscObject)viewer,&comm);
472:   MPI_Comm_compare(comm,dmmg[0]->comm,&flag);
473:   if (flag != MPI_CONGRUENT && flag != MPI_IDENT) {
474:     SETERRQ(PETSC_ERR_ARG_NOTSAMECOMM,"Different communicators in the DMMG and the PetscViewer");
475:   }

477:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
478:   if (isascii) {
479:     PetscViewerASCIIPrintf(viewer,"DMMG Object with %d levels\n",nlevels);
480:   }
481:   for (i=0; i<nlevels; i++) {
482:     PetscViewerASCIIPushTab(viewer);
483:     DMView(dmmg[i]->dm,viewer);
484:     PetscViewerASCIIPopTab(viewer);
485:   }
486:   if (isascii) {
487:     PetscViewerASCIIPrintf(viewer,"%s Object on finest level\n",dmmg[nlevels-1]->ksp ? "KSP" : "SNES");
488:     if (dmmg[nlevels-1]->galerkin) {
489:       PetscViewerASCIIPrintf(viewer,"Using Galerkin R^T*A*R process to compute coarser matrices");
490:     }
491:   }
492:   if (dmmg[nlevels-1]->ksp) {
493:     KSPView(dmmg[nlevels-1]->ksp,viewer);
494:   } else {
495:     /* use of PetscObjectView() means we do not have to link with libpetscsnes if SNES is not being used */
496:     PetscObjectView((PetscObject)dmmg[nlevels-1]->snes,viewer);
497:   }
498:   return(0);
499: }