Actual source code: damgsnes.c

  1: #define PETSCSNES_DLL
  2: 
 3:  #include petscda.h
 4:  #include src/dm/da/daimpl.h
  5: /* It appears that preprocessor directives are not respected by bfort */
  6: #ifdef PETSC_HAVE_SIEVE
 7:  #include petscmesh.h
  8: #endif
 9:  #include petscmg.h
 10:  #include petscdmmg.h

 12: #if defined(PETSC_HAVE_ADIC)
 19: #endif

 22: EXTERN PetscErrorCode  NLFCreate_DAAD(NLF*);
 23: EXTERN PetscErrorCode  NLFDAADSetDA_DAAD(NLF,DA);
 24: EXTERN PetscErrorCode  NLFDAADSetCtx_DAAD(NLF,void*);
 25: EXTERN PetscErrorCode  NLFDAADSetResidual_DAAD(NLF,Vec);
 26: EXTERN PetscErrorCode  NLFDAADSetNewtonIterations_DAAD(NLF,PetscInt);

 29: /*
 30:       period of -1 indicates update only on zeroth iteration of SNES
 31: */
 32: #define ShouldUpdate(l,it) (((dmmg[l-1]->updatejacobianperiod == -1) && (it == 0)) || \
 33:                             ((dmmg[l-1]->updatejacobianperiod >   0) && !(it % dmmg[l-1]->updatejacobianperiod)))
 34: /*
 35:    Evaluates the Jacobian on all of the grids. It is used by DMMG to provide the 
 36:    ComputeJacobian() function that SNESSetJacobian() requires.
 37: */
 40: PetscErrorCode DMMGComputeJacobian_Multigrid(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
 41: {
 42:   DMMG           *dmmg = (DMMG*)ptr;
 44:   PetscInt       i,nlevels = dmmg[0]->nlevels,it;
 45:   KSP            ksp,lksp;
 46:   PC             pc;
 47:   PetscTruth     ismg,galerkin = PETSC_FALSE;
 48:   Vec            W;
 49:   MatStructure   flg;

 52:   if (!dmmg) SETERRQ(PETSC_ERR_ARG_NULL,"Passing null as user context which should contain DMMG");
 53:   SNESGetIterationNumber(snes,&it);

 55:   /* compute Jacobian on finest grid */
 56:   if (dmmg[nlevels-1]->updatejacobian && ShouldUpdate(nlevels,it)) {
 57:     (*DMMGGetFine(dmmg)->computejacobian)(snes,X,J,B,flag,DMMGGetFine(dmmg));
 58:   } else {
 59:     PetscInfo3(0,"Skipping Jacobian, SNES iteration %D frequence %D level %D\n",it,dmmg[nlevels-1]->updatejacobianperiod,nlevels-1);
 60:     *flag = SAME_PRECONDITIONER;
 61:   }
 62:   MatMFFDSetBase(DMMGGetFine(dmmg)->J,X,PETSC_NULL);

 64:   /* create coarser grid Jacobians for preconditioner if multigrid is the preconditioner */
 65:   SNESGetKSP(snes,&ksp);
 66:   KSPGetPC(ksp,&pc);
 67:   PetscTypeCompare((PetscObject)pc,PCMG,&ismg);
 68:   if (ismg) {
 69:     PCMGGetGalerkin(pc,&galerkin);
 70:   }

 72:   if (!galerkin) {
 73:     for (i=nlevels-1; i>0; i--) {
 74:       if (!dmmg[i-1]->w) {
 75:         VecDuplicate(dmmg[i-1]->x,&dmmg[i-1]->w);
 76:       }
 77:       W    = dmmg[i-1]->w;
 78:       /* restrict X to coarser grid */
 79:       MatRestrict(dmmg[i]->R,X,W);
 80:       X    = W;
 81:       /* scale to "natural" scaling for that grid */
 82:       VecPointwiseMult(X,X,dmmg[i]->Rscale);
 83:       /* tell the base vector for matrix free multiplies */
 84:       MatMFFDSetBase(dmmg[i-1]->J,X,PETSC_NULL);
 85:       /* compute Jacobian on coarse grid */
 86:       if (dmmg[i-1]->updatejacobian && ShouldUpdate(i,it)) {
 87:         (*dmmg[i-1]->computejacobian)(snes,X,&dmmg[i-1]->J,&dmmg[i-1]->B,&flg,dmmg[i-1]);
 88:         flg = SAME_NONZERO_PATTERN;
 89:       } else {
 90:         PetscInfo3(0,"Skipping Jacobian, SNES iteration %D frequence %D level %D\n",it,dmmg[i-1]->updatejacobianperiod,i-1);
 91:         flg = SAME_PRECONDITIONER;
 92:       }
 93:       if (ismg) {
 94:         PCMGGetSmoother(pc,i-1,&lksp);
 95:         KSPSetOperators(lksp,dmmg[i-1]->J,dmmg[i-1]->B,flg);
 96:       }
 97:     }
 98:   }
 99:   return(0);
100: }

102: /* ---------------------------------------------------------------------------*/


107: /* 
108:    DMMGFormFunction - This is a universal global FormFunction used by the DMMG code
109:    when the user provides a local function.

111:    Input Parameters:
112: +  snes - the SNES context
113: .  X - input vector
114: -  ptr - optional user-defined context, as set by SNESSetFunction()

116:    Output Parameter:
117: .  F - function vector

119:  */
120: PetscErrorCode DMMGFormFunction(SNES snes,Vec X,Vec F,void *ptr)
121: {
122:   DMMG           dmmg = (DMMG)ptr;
124:   Vec            localX;
125:   DA             da = (DA)dmmg->dm;

128:   DAGetLocalVector(da,&localX);
129:   /*
130:      Scatter ghost points to local vector, using the 2-step process
131:         DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
132:   */
133:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
134:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
135:   DAFormFunction1(da,localX,F,dmmg->user);
136:   DARestoreLocalVector(da,&localX);
137:   return(0);
138: }

142: PetscErrorCode DMMGFormFunctionGhost(SNES snes,Vec X,Vec F,void *ptr)
143: {
144:   DMMG           dmmg = (DMMG)ptr;
146:   Vec            localX, localF;
147:   DA             da = (DA)dmmg->dm;

150:   DAGetLocalVector(da,&localX);
151:   DAGetLocalVector(da,&localF);
152:   /*
153:      Scatter ghost points to local vector, using the 2-step process
154:         DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
155:   */
156:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
157:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
158:   VecSet(F, 0.0);
159:   VecSet(localF, 0.0);
160:   DAFormFunction1(da,localX,localF,dmmg->user);
161:   DALocalToGlobalBegin(da,localF,F);
162:   DALocalToGlobalEnd(da,localF,F);
163:   DARestoreLocalVector(da,&localX);
164:   DARestoreLocalVector(da,&localF);
165:   return(0);
166: }

168: #ifdef PETSC_HAVE_SIEVE
171: /* 
172:    DMMGFormFunctionMesh - This is a universal global FormFunction used by the DMMG code
173:    when the user provides a local function.

175:    Input Parameters:
176: +  snes - the SNES context
177: .  X - input vector
178: -  ptr - This is the DMMG object

180:    Output Parameter:
181: .  F - function vector

183:  */
184: PetscErrorCode DMMGFormFunctionMesh(SNES snes, Vec X, Vec F, void *ptr)
185: {
186:   DMMG           dmmg = (DMMG) ptr;
187:   Mesh           mesh = (Mesh) dmmg->dm;
188:   SectionReal    sectionX, section;

192:   MeshGetSectionReal(mesh, "default", &section);
193:   SectionRealDuplicate(section, &sectionX);
194:   SectionRealToVec(sectionX, mesh, SCATTER_REVERSE, X);
195:   MeshFormFunction(mesh, sectionX, section, dmmg->user);
196:   SectionRealToVec(section, mesh, SCATTER_FORWARD, F);
197:   SectionRealDestroy(sectionX);
198:   SectionRealDestroy(section);
199:   return(0);
200: }

204: /* 
205:    DMMGComputeJacobianMesh - This is a universal global FormJacobian used by the DMMG code
206:    when the user provides a local function.

208:    Input Parameters:
209: +  snes - the SNES context
210: .  X - input vector
211: -  ptr - This is the DMMG object

213:    Output Parameter:
214: .  F - function vector

216:  */
217: PetscErrorCode DMMGComputeJacobianMesh(SNES snes, Vec X, Mat *J, Mat *B, MatStructure *flag, void *ptr)
218: {
219:   DMMG           dmmg = (DMMG) ptr;
220:   Mesh           mesh = (Mesh) dmmg->dm;
221:   SectionReal    sectionX;

225:   MeshGetSectionReal(mesh, "default", &sectionX);
226:   SectionRealToVec(sectionX, mesh, SCATTER_REVERSE, X);
227:   MeshFormJacobian(mesh, sectionX, *B, dmmg->user);
228:   /* Assemble true Jacobian; if it is different */
229:   if (*J != *B) {
230:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
231:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
232:   }
233:   MatSetOption(*B, MAT_NEW_NONZERO_LOCATION_ERR);
234:   *flag = SAME_NONZERO_PATTERN;
235:   SectionRealDestroy(sectionX);
236:   return(0);
237: }
238: #endif

242: /* 
243:    DMMGFormFunctionFD - This is a universal global FormFunction used by the DMMG code
244:    when the user provides a local function used to compute the Jacobian via FD.

246:    Input Parameters:
247: +  snes - the SNES context
248: .  X - input vector
249: -  ptr - optional user-defined context, as set by SNESSetFunction()

251:    Output Parameter:
252: .  F - function vector

254:  */
255: PetscErrorCode DMMGFormFunctionFD(SNES snes,Vec X,Vec F,void *ptr)
256: {
257:   DMMG           dmmg = (DMMG)ptr;
259:   Vec            localX;
260:   DA             da = (DA)dmmg->dm;
261:   PetscInt       N,n;
262: 
264:   /* determine whether X=localX */
265:   DAGetLocalVector(da,&localX);
266:   VecGetSize(X,&N);
267:   VecGetSize(localX,&n);

269:   if (n != N){ /* X != localX */
270:     /* Scatter ghost points to local vector, using the 2-step process
271:        DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
272:     */
273:     DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
274:     DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
275:   } else {
276:     DARestoreLocalVector(da,&localX);
277:     localX = X;
278:   }
279:   DAFormFunction(da,dmmg->lfj,localX,F,dmmg->user);
280:   if (n != N){
281:     DARestoreLocalVector(da,&localX);
282:   }
283:   return(0);
284: }

288: /*@C 
289:    SNESDAFormFunction - This is a universal function evaluation routine that
290:    may be used with SNESSetFunction() as long as the user context has a DA
291:    as its first record and the user has called DASetLocalFunction().

293:    Collective on SNES

295:    Input Parameters:
296: +  snes - the SNES context
297: .  X - input vector
298: .  F - function vector
299: -  ptr - pointer to a structure that must have a DA as its first entry. For example this 
300:          could be a DMMG, this ptr must have been passed into SNESDAFormFunction() as the context

302:    Level: intermediate

304: .seealso: DASetLocalFunction(), DASetLocalJacobian(), DASetLocalAdicFunction(), DASetLocalAdicMFFunction(),
305:           SNESSetFunction(), SNESSetJacobian()

307: @*/
308: PetscErrorCode  SNESDAFormFunction(SNES snes,Vec X,Vec F,void *ptr)
309: {
311:   Vec            localX;
312:   DA             da = *(DA*)ptr;
313:   PetscInt       N,n;
314: 
316:   if (!da) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Looks like you called SNESSetFromFuntion(snes,SNESDAFormFunction,) without the DA context");

318:   /* determine whether X=localX */
319:   DAGetLocalVector(da,&localX);
320:   VecGetSize(X,&N);
321:   VecGetSize(localX,&n);
322: 
323: 
324:   if (n != N){ /* X != localX */
325:     /* Scatter ghost points to local vector, using the 2-step process
326:         DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
327:     */
328:     DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
329:     DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
330:   } else {
331:     DARestoreLocalVector(da,&localX);
332:     localX = X;
333:   }
334:   DAFormFunction1(da,localX,F,ptr);
335:   if (n != N){
336:     if (PetscExceptionValue(ierr)) {
337:       PetscErrorCode pDARestoreLocalVector(da,&localX);CHKERRQ(pierr);
338:     }
339: 
340:     DARestoreLocalVector(da,&localX);
341:   }
342:   return(0);
343: }

345: /* ------------------------------------------------------------------------------*/
346:  #include include/private/matimpl.h
349: PetscErrorCode DMMGComputeJacobianWithFD(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
350: {
352:   DMMG           dmmg = (DMMG)ctx;
353:   MatFDColoring  color = (MatFDColoring)dmmg->fdcoloring;
354: 
356:   if (color->ctype == IS_COLORING_GHOSTED){
357:     DA            da=(DA)dmmg->dm;
358:     Vec           x1_loc;
359:     DAGetLocalVector(da,&x1_loc);
360:     DAGlobalToLocalBegin(da,x1,INSERT_VALUES,x1_loc);
361:     DAGlobalToLocalEnd(da,x1,INSERT_VALUES,x1_loc);
362:     SNESDefaultComputeJacobianColor(snes,x1_loc,J,B,flag,dmmg->fdcoloring);
363:     DARestoreLocalVector(da,&x1_loc);
364:   } else {
365:     SNESDefaultComputeJacobianColor(snes,x1,J,B,flag,dmmg->fdcoloring);
366:   }
367:   return(0);
368: }

372: PetscErrorCode DMMGComputeJacobianWithMF(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
373: {
375: 
377:   MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
378:   MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
379:   return(0);
380: }

384: /*
385:     DMMGComputeJacobian - Evaluates the Jacobian when the user has provided
386:     a local function evaluation routine.
387: */
388: PetscErrorCode DMMGComputeJacobian(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
389: {
390:   DMMG           dmmg = (DMMG) ptr;
392:   Vec            localX;
393:   DA             da = (DA) dmmg->dm;

396:   DAGetLocalVector(da,&localX);
397:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
398:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
399:   DAComputeJacobian1(da,localX,*B,dmmg->user);
400:   DARestoreLocalVector(da,&localX);
401:   /* Assemble true Jacobian; if it is different */
402:   if (*J != *B) {
403:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
404:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
405:   }
406:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
407:   *flag = SAME_NONZERO_PATTERN;
408:   return(0);
409: }

413: /*
414:     SNESDAComputeJacobianWithAdifor - This is a universal Jacobian evaluation routine
415:     that may be used with SNESSetJacobian() from Fortran as long as the user context has 
416:     a DA as its first record and DASetLocalAdiforFunction() has been called.  

418:    Collective on SNES

420:    Input Parameters:
421: +  snes - the SNES context
422: .  X - input vector
423: .  J - Jacobian
424: .  B - Jacobian used in preconditioner (usally same as J)
425: .  flag - indicates if the matrix changed its structure
426: -  ptr - optional user-defined context, as set by SNESSetFunction()

428:    Level: intermediate

430: .seealso: DASetLocalFunction(), DASetLocalAdicFunction(), SNESSetFunction(), SNESSetJacobian()

432: */
433: PetscErrorCode  SNESDAComputeJacobianWithAdifor(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
434: {
435:   DA             da = *(DA*) ptr;
437:   Vec            localX;

440:   DAGetLocalVector(da,&localX);
441:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
442:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
443:   DAComputeJacobian1WithAdifor(da,localX,*B,ptr);
444:   DARestoreLocalVector(da,&localX);
445:   /* Assemble true Jacobian; if it is different */
446:   if (*J != *B) {
447:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
448:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
449:   }
450:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
451:   *flag = SAME_NONZERO_PATTERN;
452:   return(0);
453: }

457: /*
458:    SNESDAComputeJacobian - This is a universal Jacobian evaluation routine for a
459:    locally provided Jacobian.

461:    Collective on SNES

463:    Input Parameters:
464: +  snes - the SNES context
465: .  X - input vector
466: .  J - Jacobian
467: .  B - Jacobian used in preconditioner (usally same as J)
468: .  flag - indicates if the matrix changed its structure
469: -  ptr - optional user-defined context, as set by SNESSetFunction()

471:    Level: intermediate

473: .seealso: DASetLocalFunction(), DASetLocalJacobian(), SNESSetFunction(), SNESSetJacobian()

475: */
476: PetscErrorCode  SNESDAComputeJacobian(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
477: {
478:   DA             da = *(DA*) ptr;
480:   Vec            localX;

483:   DAGetLocalVector(da,&localX);
484:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
485:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
486:   DAComputeJacobian1(da,localX,*B,ptr);
487:   DARestoreLocalVector(da,&localX);
488:   /* Assemble true Jacobian; if it is different */
489:   if (*J != *B) {
490:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
491:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
492:   }
493:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
494:   *flag = SAME_NONZERO_PATTERN;
495:   return(0);
496: }

500: PetscErrorCode DMMGSolveSNES(DMMG *dmmg,PetscInt level)
501: {
503:   PetscInt       nlevels = dmmg[0]->nlevels;

506:   dmmg[0]->nlevels = level+1;
507:   SNESSolve(dmmg[level]->snes,PETSC_NULL,dmmg[level]->x);
508:   dmmg[0]->nlevels = nlevels;
509:   return(0);
510: }

512: /* ===========================================================================================================*/

516: /*@C
517:     DMMGSetSNES - Sets the nonlinear function that defines the nonlinear set of equations
518:     to be solved using the grid hierarchy.

520:     Collective on DMMG

522:     Input Parameter:
523: +   dmmg - the context
524: .   function - the function that defines the nonlinear system
525: -   jacobian - optional function to compute Jacobian

527:     Options Database Keys:
528: +    -dmmg_snes_monitor
529: .    -dmmg_jacobian_fd
530: .    -dmmg_jacobian_ad
531: .    -dmmg_jacobian_mf_fd_operator
532: .    -dmmg_jacobian_mf_fd
533: .    -dmmg_jacobian_mf_ad_operator
534: .    -dmmg_jacobian_mf_ad
535: .    -dmmg_iscoloring_type
536: -    -dmmg_jacobian_period <p> - Indicates how often in the SNES solve the Jacobian is recomputed (on all levels)
537:                                  as suggested by Florin Dobrian if p is -1 then Jacobian is computed only on first
538:                                  SNES iteration (i.e. -1 is equivalent to infinity) 

540:     Level: advanced

542: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP(), DMMGSetSNESLocal()

544: @*/
545: PetscErrorCode  DMMGSetSNES(DMMG *dmmg,PetscErrorCode (*function)(SNES,Vec,Vec,void*),PetscErrorCode (*jacobian)(SNES,Vec,Mat*,Mat*,MatStructure*,void*))
546: {
547:   PetscErrorCode          ierr;
548:   PetscInt                i,nlevels = dmmg[0]->nlevels,period = 1;
549:   PetscTruth              snesmonitor,mffdoperator,mffd,fdjacobian;
550: #if defined(PETSC_HAVE_ADIC)
551:   PetscTruth              mfadoperator,mfad,adjacobian;
552: #endif
553:   PetscViewerASCIIMonitor ascii;
554:   MPI_Comm                comm;

557:   if (!dmmg)     SETERRQ(PETSC_ERR_ARG_NULL,"Passing null as DMMG");
558:   if (!jacobian) jacobian = DMMGComputeJacobianWithFD;

560:   PetscOptionsBegin(dmmg[0]->comm,PETSC_NULL,"DMMG Options","SNES");
561:     PetscOptionsName("-dmmg_snes_monitor","Monitor nonlinear convergence","SNESMonitorSet",&snesmonitor);


564:     PetscOptionsName("-dmmg_jacobian_fd","Compute sparse Jacobian explicitly with finite differencing","DMMGSetSNES",&fdjacobian);
565:     if (fdjacobian) jacobian = DMMGComputeJacobianWithFD;
566: #if defined(PETSC_HAVE_ADIC)
567:     PetscOptionsName("-dmmg_jacobian_ad","Compute sparse Jacobian explicitly with ADIC (automatic differentiation)","DMMGSetSNES",&adjacobian);
568:     if (adjacobian) jacobian = DMMGComputeJacobianWithAdic;
569: #endif

571:     PetscOptionsTruthGroupBegin("-dmmg_jacobian_mf_fd_operator","Apply Jacobian via matrix free finite differencing","DMMGSetSNES",&mffdoperator);
572:     PetscOptionsTruthGroupEnd("-dmmg_jacobian_mf_fd","Apply Jacobian via matrix free finite differencing even in computing preconditioner","DMMGSetSNES",&mffd);
573:     if (mffd) mffdoperator = PETSC_TRUE;
574: #if defined(PETSC_HAVE_ADIC)
575:     PetscOptionsTruthGroupBegin("-dmmg_jacobian_mf_ad_operator","Apply Jacobian via matrix free ADIC (automatic differentiation)","DMMGSetSNES",&mfadoperator);
576:     PetscOptionsTruthGroupEnd("-dmmg_jacobian_mf_ad","Apply Jacobian via matrix free ADIC (automatic differentiation) even in computing preconditioner","DMMGSetSNES",&mfad);
577:     if (mfad) mfadoperator = PETSC_TRUE;
578: #endif
579:     PetscOptionsEnum("-dmmg_iscoloring_type","Type of ISColoring","None",ISColoringTypes,(PetscEnum)dmmg[0]->isctype,(PetscEnum*)&dmmg[0]->isctype,PETSC_NULL);
580: 
581:   PetscOptionsEnd();

583:   /* create solvers for each level */
584:   for (i=0; i<nlevels; i++) {
585:     SNESCreate(dmmg[i]->comm,&dmmg[i]->snes);
586:     SNESSetFunction(dmmg[i]->snes,dmmg[i]->b,function,dmmg[i]);
587:     SNESSetOptionsPrefix(dmmg[i]->snes,dmmg[i]->prefix);
588:     SNESGetKSP(dmmg[i]->snes,&dmmg[i]->ksp);
589:     if (snesmonitor) {
590:       PetscObjectGetComm((PetscObject)dmmg[i]->snes,&comm);
591:       PetscViewerASCIIMonitorCreate(comm,"stdout",nlevels-i,&ascii);
592:       SNESMonitorSet(dmmg[i]->snes,SNESMonitorDefault,ascii,(PetscErrorCode(*)(void*))PetscViewerASCIIMonitorDestroy);
593:     }

595:     if (mffdoperator) {
596:       MatCreateSNESMF(dmmg[i]->snes,&dmmg[i]->J);
597:       VecDuplicate(dmmg[i]->x,&dmmg[i]->work1);
598:       VecDuplicate(dmmg[i]->x,&dmmg[i]->work2);
599:       MatMFFDSetFunction(dmmg[i]->J,(PetscErrorCode (*)(void*, Vec,Vec))SNESComputeFunction,dmmg[i]->snes);
600:       if (mffd) {
601:         dmmg[i]->B = dmmg[i]->J;
602:         jacobian   = DMMGComputeJacobianWithMF;
603:       }
604: #if defined(PETSC_HAVE_ADIC)
605:     } else if (mfadoperator) {
606:       MatRegisterDAAD();
607:       MatCreateDAAD((DA)dmmg[i]->dm,&dmmg[i]->J);
608:       MatDAADSetCtx(dmmg[i]->J,dmmg[i]->user);
609:       if (mfad) {
610:         dmmg[i]->B = dmmg[i]->J;
611:         jacobian   = DMMGComputeJacobianWithMF;
612:       }
613: #endif
614:     }
615: 
616:     if (!dmmg[i]->B) {
617:       DMGetMatrix(dmmg[i]->dm,dmmg[i]->mtype,&dmmg[i]->B);
618:     }
619:     if (!dmmg[i]->J) {
620:       dmmg[i]->J = dmmg[i]->B;
621:     }

623:     DMMGSetUpLevel(dmmg,dmmg[i]->ksp,i+1);
624: 
625:     /*
626:        if the number of levels is > 1 then we want the coarse solve in the grid sequencing to use LU
627:        when possible 
628:     */
629:     if (nlevels > 1 && i == 0) {
630:       PC         pc;
631:       KSP        cksp;
632:       PetscTruth flg1,flg2,flg3;

634:       KSPGetPC(dmmg[i]->ksp,&pc);
635:       PCMGGetCoarseSolve(pc,&cksp);
636:       KSPGetPC(cksp,&pc);
637:       PetscTypeCompare((PetscObject)pc,PCILU,&flg1);
638:       PetscTypeCompare((PetscObject)pc,PCSOR,&flg2);
639:       PetscTypeCompare((PetscObject)pc,PETSC_NULL,&flg3);
640:       if (flg1 || flg2 || flg3) {
641:         PCSetType(pc,PCLU);
642:       }
643:     }

645:     dmmg[i]->solve           = DMMGSolveSNES;
646:     dmmg[i]->computejacobian = jacobian;
647:     dmmg[i]->computefunction = function;
648:   }

650:   if (jacobian == DMMGComputeJacobianWithFD) {
651:     ISColoring iscoloring;

653:     for (i=0; i<nlevels; i++) {
654:       DMGetColoring(dmmg[i]->dm,dmmg[0]->isctype,&iscoloring);
655:       MatFDColoringCreate(dmmg[i]->B,iscoloring,&dmmg[i]->fdcoloring);
656:       ISColoringDestroy(iscoloring);
657:       if (function == DMMGFormFunction) function = DMMGFormFunctionFD;
658:       MatFDColoringSetFunction(dmmg[i]->fdcoloring,(PetscErrorCode(*)(void))function,dmmg[i]);
659:       MatFDColoringSetFromOptions(dmmg[i]->fdcoloring);
660:     }
661: #if defined(PETSC_HAVE_ADIC)
662:   } else if (jacobian == DMMGComputeJacobianWithAdic) {
663:     for (i=0; i<nlevels; i++) {
664:       ISColoring iscoloring;
665:       DMGetColoring(dmmg[i]->dm,IS_COLORING_GHOSTED,&iscoloring);
666:       MatSetColoring(dmmg[i]->B,iscoloring);
667:       ISColoringDestroy(iscoloring);
668:     }
669: #endif
670:   }
671:   for (i=0; i<nlevels; i++) {
672:     SNESSetJacobian(dmmg[i]->snes,dmmg[i]->J,dmmg[i]->B,DMMGComputeJacobian_Multigrid,dmmg);
673:     SNESSetFromOptions(dmmg[i]->snes);
674:   }

676:   /* Create interpolation scaling */
677:   for (i=1; i<nlevels; i++) {
678:     DMGetInterpolationScale(dmmg[i-1]->dm,dmmg[i]->dm,dmmg[i]->R,&dmmg[i]->Rscale);
679:   }

681:   PetscOptionsGetInt(PETSC_NULL,"-dmmg_jacobian_period",&period,PETSC_NULL);
682:   for (i=0; i<nlevels; i++) {
683:     dmmg[i]->updatejacobian       = PETSC_TRUE;
684:     dmmg[i]->updatejacobianperiod = period;
685:   }

687: #if defined(PETSC_HAVE_ADIC)
688:   {
689:     PetscTruth flg;
690:     PetscOptionsHasName(PETSC_NULL,"-dmmg_fas",&flg);
691:     if (flg) {
692:       PetscTruth block = PETSC_FALSE;
693:       PetscTruth ngmres = PETSC_FALSE;
694:       PetscInt   newton_its;
695:       PetscOptionsHasName(0,"-dmmg_fas_view",&flg);
696:       for (i=0; i<nlevels; i++) {
697:         NLFCreate_DAAD(&dmmg[i]->nlf);
698:         NLFDAADSetDA_DAAD(dmmg[i]->nlf,(DA)dmmg[i]->dm);
699:         NLFDAADSetCtx_DAAD(dmmg[i]->nlf,dmmg[i]->user);
700:         NLFDAADSetResidual_DAAD(dmmg[i]->nlf,dmmg[i]->r);
701:         VecDuplicate(dmmg[i]->b,&dmmg[i]->w);

703:         dmmg[i]->monitor    = PETSC_FALSE;
704:         PetscOptionsHasName(0,"-dmmg_fas_monitor",&dmmg[i]->monitor);
705:         dmmg[i]->monitorall = PETSC_FALSE;
706:         PetscOptionsHasName(0,"-dmmg_fas_monitor_all",&dmmg[i]->monitorall);
707:         dmmg[i]->presmooth  = 2;
708:         PetscOptionsGetInt(0,"-dmmg_fas_presmooth",&dmmg[i]->presmooth,0);
709:         dmmg[i]->postsmooth = 2;
710:         PetscOptionsGetInt(0,"-dmmg_fas_postsmooth",&dmmg[i]->postsmooth,0);
711:         dmmg[i]->coarsesmooth = 2;
712:         PetscOptionsGetInt(0,"-dmmg_fas_coarsesmooth",&dmmg[i]->coarsesmooth,0);

714:         dmmg[i]->rtol = 1.e-8;
715:         PetscOptionsGetReal(0,"-dmmg_fas_rtol",&dmmg[i]->rtol,0);
716:         dmmg[i]->abstol = 1.e-50;
717:         PetscOptionsGetReal(0,"-dmmg_fas_atol",&dmmg[i]->abstol,0);

719:         newton_its = 2;
720:         PetscOptionsGetInt(0,"-dmmg_fas_newton_its",&newton_its,0);
721:         NLFDAADSetNewtonIterations_DAAD(dmmg[i]->nlf,newton_its);

723:         if (flg) {
724:           if (i == 0) {
725:             PetscPrintf(dmmg[i]->comm,"FAS Solver Parameters\n");
726:             PetscPrintf(dmmg[i]->comm,"  rtol %G atol %G\n",dmmg[i]->rtol,dmmg[i]->abstol);
727:             PetscPrintf(dmmg[i]->comm,"             coarsesmooths %D\n",dmmg[i]->coarsesmooth);
728:             PetscPrintf(dmmg[i]->comm,"             Newton iterations %D\n",newton_its);
729:           } else {
730:             PetscPrintf(dmmg[i]->comm,"  level %D   presmooths    %D\n",i,dmmg[i]->presmooth);
731:             PetscPrintf(dmmg[i]->comm,"             postsmooths   %D\n",dmmg[i]->postsmooth);
732:             PetscPrintf(dmmg[i]->comm,"             Newton iterations %D\n",newton_its);
733:           }
734:         }
735:         PetscOptionsHasName(0,"-dmmg_fas_block",&block);
736:         PetscOptionsHasName(0,"-dmmg_fas_ngmres",&ngmres);
737:         if (block) {
738:           dmmg[i]->solve = DMMGSolveFASb;
739:           if (flg) {
740:             PetscPrintf(dmmg[i]->comm,"  using point-block smoothing\n");
741:           }
742:         } else if(ngmres) {
743:           dmmg[i]->solve = DMMGSolveFAS_NGMRES;
744:           if (flg) {
745:             PetscPrintf(dmmg[i]->comm,"  using non-linear gmres\n");
746:           }
747:         } else {
748:           dmmg[i]->solve = DMMGSolveFAS4;
749:         }
750:       }
751:     }
752:   }
753: #endif
754: 
755:   return(0);
756: }

760: /*@
761:     DMMGSetSNESLocalFD - Sets the local user function that is used to approximately compute the Jacobian
762:         via finite differences.

764:     Collective on DMMG

766:     Input Parameter:
767: +   dmmg - the context
768: -   function - the function that defines the nonlinear system

770:     Level: intermediate

772: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP(), DMMGSetSNES(), DMMGSetSNESLocal()

774: @*/
775: PetscErrorCode DMMGSetSNESLocalFD(DMMG *dmmg,DALocalFunction1 function)
776: {
777:   PetscInt       i,nlevels = dmmg[0]->nlevels;

780:   for (i=0; i<nlevels; i++) {
781:     dmmg[i]->lfj = (PetscErrorCode (*)(void))function;
782:   }
783:   return(0);
784: }


787: /*M
788:     DMMGSetSNESLocal - Sets the local user function that defines the nonlinear set of equations
789:     that will use the grid hierarchy and (optionally) its derivative.

791:     Collective on DMMG

793:    Synopsis:
794:    PetscErrorCode DMMGSetSNESLocal(DMMG *dmmg,DALocalFunction1 function, DALocalFunction1 jacobian,
795:                         DALocalFunction1 ad_function, DALocalFunction1 admf_function);

797:     Input Parameter:
798: +   dmmg - the context
799: .   function - the function that defines the nonlinear system
800: .   jacobian - function defines the local part of the Jacobian
801: .   ad_function - the name of the function with an ad_ prefix. This is ignored if ADIC is
802:                   not installed
803: -   admf_function - the name of the function with an ad_ prefix. This is ignored if ADIC is
804:                   not installed

806:     Options Database Keys:
807: +    -dmmg_snes_monitor
808: .    -dmmg_jacobian_fd
809: .    -dmmg_jacobian_ad
810: .    -dmmg_jacobian_mf_fd_operator
811: .    -dmmg_jacobian_mf_fd
812: .    -dmmg_jacobian_mf_ad_operator
813: .    -dmmg_jacobian_mf_ad
814: -    -dmmg_jacobian_period <p> - Indicates how often in the SNES solve the Jacobian is recomputed (on all levels)
815:                                  as suggested by Florin Dobrian if p is -1 then Jacobian is computed only on first
816:                                  SNES iteration (i.e. -1 is equivalent to infinity) 


819:     Level: intermediate

821:     Notes: 
822:     If ADIC or ADIFOR have been installed, this routine can use ADIC or ADIFOR to compute
823:     the derivative; however, that function cannot call other functions except those in
824:     standard C math libraries.

826:     If ADIC/ADIFOR have not been installed and the Jacobian is not provided, this routine
827:     uses finite differencing to approximate the Jacobian.

829: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP(), DMMGSetSNES()

831: M*/

835: PetscErrorCode DMMGSetSNESLocal_Private(DMMG *dmmg,DALocalFunction1 function,DALocalFunction1 jacobian,DALocalFunction1 ad_function,DALocalFunction1 admf_function)
836: {
838:   PetscInt       i,nlevels = dmmg[0]->nlevels,cookie;
839:   PetscErrorCode (*computejacobian)(SNES,Vec,Mat*,Mat*,MatStructure*,void*) = 0;


843:   if (jacobian)         computejacobian = DMMGComputeJacobian;
844: #if defined(PETSC_HAVE_ADIC)
845:   else if (ad_function) computejacobian = DMMGComputeJacobianWithAdic;
846: #endif
847:   CHKMEMQ;
848:   PetscObjectGetCookie((PetscObject) dmmg[0]->dm,&cookie);
849:   if (cookie == DA_COOKIE) {
850:     PetscTruth flag;
851:     PetscOptionsHasName(PETSC_NULL, "-dmmg_form_function_ghost", &flag);
852:     if (flag) {
853:       DMMGSetSNES(dmmg,DMMGFormFunctionGhost,computejacobian);
854:     } else {
855:       DMMGSetSNES(dmmg,DMMGFormFunction,computejacobian);
856:     }
857:     for (i=0; i<nlevels; i++) {
858:       DASetLocalFunction((DA)dmmg[i]->dm,function);
859:       dmmg[i]->lfj = (PetscErrorCode (*)(void))function;
860:       DASetLocalJacobian((DA)dmmg[i]->dm,jacobian);
861:       DASetLocalAdicFunction((DA)dmmg[i]->dm,ad_function);
862:       DASetLocalAdicMFFunction((DA)dmmg[i]->dm,admf_function);
863:     }
864:   CHKMEMQ;
865:   } else {
866: #ifdef PETSC_HAVE_SIEVE
867:     DMMGSetSNES(dmmg, DMMGFormFunctionMesh, DMMGComputeJacobianMesh);
868:     for (i=0; i<nlevels; i++) {
869:       MeshSetLocalFunction((Mesh) dmmg[i]->dm, (PetscErrorCode (*)(Mesh,SectionReal,SectionReal,void*)) function);
870:       dmmg[i]->lfj = (PetscErrorCode (*)(void)) function;
871:       MeshSetLocalJacobian((Mesh) dmmg[i]->dm, (PetscErrorCode (*)(Mesh,SectionReal,Mat,void*)) jacobian);
872:     }
873:   CHKMEMQ;
874: #endif
875:   }
876:   CHKMEMQ;
877:   return(0);
878: }

882: PetscErrorCode DMMGFunctioni(void* ctx,PetscInt i,Vec u,PetscScalar* r)
883: {
884:   DMMG           dmmg = (DMMG)ctx;
885:   Vec            U = dmmg->lwork1;
887:   VecScatter     gtol;

890:   /* copy u into interior part of U */
891:   DAGetScatter((DA)dmmg->dm,0,&gtol,0);
892:   VecScatterBegin(gtol,u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL);
893:   VecScatterEnd(gtol,u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL);
894:   DAFormFunctioni1((DA)dmmg->dm,i,U,r,dmmg->user);
895:   return(0);
896: }

900: PetscErrorCode DMMGFunctionib(PetscInt i,Vec u,PetscScalar* r,void* ctx)
901: {
902:   DMMG           dmmg = (DMMG)ctx;
903:   Vec            U = dmmg->lwork1;
905:   VecScatter     gtol;

908:   /* copy u into interior part of U */
909:   DAGetScatter((DA)dmmg->dm,0,&gtol,0);
910:   VecScatterBegin(gtol,u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL);
911:   VecScatterEnd(gtol,u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL);
912:   DAFormFunctionib1((DA)dmmg->dm,i,U,r,dmmg->user);
913:   return(0);
914: }

918: PetscErrorCode DMMGFunctioniBase(void* ctx,Vec u)
919: {
920:   DMMG           dmmg = (DMMG)ctx;
921:   Vec            U = dmmg->lwork1;

925:   DAGlobalToLocalBegin((DA)dmmg->dm,u,INSERT_VALUES,U);
926:   DAGlobalToLocalEnd((DA)dmmg->dm,u,INSERT_VALUES,U);
927:   return(0);
928: }

932: PetscErrorCode DMMGSetSNESLocali_Private(DMMG *dmmg,PetscErrorCode (*functioni)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*),PetscErrorCode (*adi)(DALocalInfo*,MatStencil*,void*,void*,void*),PetscErrorCode (*adimf)(DALocalInfo*,MatStencil*,void*,void*,void*))
933: {
935:   PetscInt       i,nlevels = dmmg[0]->nlevels;

938:   for (i=0; i<nlevels; i++) {
939:     DASetLocalFunctioni((DA)dmmg[i]->dm,functioni);
940:     DASetLocalAdicFunctioni((DA)dmmg[i]->dm,adi);
941:     DASetLocalAdicMFFunctioni((DA)dmmg[i]->dm,adimf);
942:     MatMFFDSetFunctioni(dmmg[i]->J,DMMGFunctioni);
943:     MatMFFDSetFunctioniBase(dmmg[i]->J,DMMGFunctioniBase);
944:     if (!dmmg[i]->lwork1) {
945:       DACreateLocalVector((DA)dmmg[i]->dm,&dmmg[i]->lwork1);
946:     }
947:   }
948:   return(0);
949: }

953: PetscErrorCode DMMGSetSNESLocalib_Private(DMMG *dmmg,PetscErrorCode (*functioni)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*),PetscErrorCode (*adi)(DALocalInfo*,MatStencil*,void*,void*,void*),PetscErrorCode (*adimf)(DALocalInfo*,MatStencil*,void*,void*,void*))
954: {
956:   PetscInt       i,nlevels = dmmg[0]->nlevels;

959:   for (i=0; i<nlevels; i++) {
960:     DASetLocalFunctionib((DA)dmmg[i]->dm,functioni);
961:     DASetLocalAdicFunctionib((DA)dmmg[i]->dm,adi);
962:     DASetLocalAdicMFFunctionib((DA)dmmg[i]->dm,adimf);
963:     if (!dmmg[i]->lwork1) {
964:       DACreateLocalVector((DA)dmmg[i]->dm,&dmmg[i]->lwork1);
965:     }
966:   }
967:   return(0);
968: }

970: static PetscErrorCode (*localfunc)(void) = 0;

974: /*
975:     Uses the DM object to call the user provided function with the correct calling
976:   sequence.
977: */
978: PetscErrorCode  DMMGInitialGuess_Local(DMMG dmmg,Vec x)
979: {

983:   (*dmmg->dm->ops->forminitialguess)(dmmg->dm,localfunc,x,0);
984:   return(0);
985: }

989: /*@C
990:     DMMGSetInitialGuessLocal - sets code to compute the initial guess for each level

992:     Collective on DMMG

994:     Input Parameter:
995: +   dmmg - the context
996: -   localguess - the function that computes the initial guess

998:     Level: intermediate

1000: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP(), DMMGSetSNES(), DMMGSetInitialGuess(), DMMGSetSNESLocal()

1002: @*/
1003: PetscErrorCode DMMGSetInitialGuessLocal(DMMG *dmmg,PetscErrorCode (*localguess)(void))
1004: {

1008:   localfunc = localguess;  /* stash into ugly static for now */

1010:   DMMGSetInitialGuess(dmmg,DMMGInitialGuess_Local);
1011:   return(0);
1012: }

1016: /*@C
1017:     DMMGSetISColoringType - type of coloring used to compute Jacobian via finite differencing

1019:     Collective on DMMG

1021:     Input Parameter:
1022: +   dmmg - the context
1023: -   isctype - IS_COLORING_GHOSTED (default) or IS_COLORING_GLOBAL

1025:     Options Database:
1026: .   -dmmg_iscoloring_type <ghosted or global>

1028:     Notes: ghosted coloring requires using DMMGSetSNESLocal()

1030:     Level: intermediate

1032: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP(), DMMGSetSNES(), DMMGSetInitialGuess(), DMMGSetSNESLocal()

1034: @*/
1035: PetscErrorCode DMMGSetISColoringType(DMMG *dmmg,ISColoringType isctype)
1036: {
1038:   dmmg[0]->isctype = isctype;
1039:   return(0);
1040: }