Actual source code: damgsnes.c

  1: /*$Id: damgsnes.c,v 1.51 2001/08/06 21:18:06 bsmith Exp $*/
  2: 
 3:  #include petscda.h
 4:  #include petscmg.h


  7: /*
  8:       period of -1 indicates update only on zeroth iteration of SNES
  9: */
 10: #define ShouldUpdate(l,it) (((dmmg[l-1]->updatejacobianperiod == -1) && (it == 0)) || \
 11:                             ((dmmg[l-1]->updatejacobianperiod >   0) && !(it % dmmg[l-1]->updatejacobianperiod)))
 12: /*
 13:    Evaluates the Jacobian on all of the grids. It is used by DMMG to provide the 
 14:    ComputeJacobian() function that SNESSetJacobian() requires.
 15: */
 18: int DMMGComputeJacobian_Multigrid(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
 19: {
 20:   DMMG         *dmmg = (DMMG*)ptr;
 21:   int          ierr,i,nlevels = dmmg[0]->nlevels,it;
 22:   KSP          ksp,lksp;
 23:   PC           pc;
 24:   PetscTruth   ismg;
 25:   Vec          W;
 26:   MatStructure flg;

 29:   if (!dmmg) SETERRQ(1,"Passing null as user context which should contain DMMG");
 30:   SNESGetIterationNumber(snes,&it);

 32:   /* compute Jacobian on finest grid */
 33:   if (dmmg[nlevels-1]->updatejacobian && ShouldUpdate(nlevels,it)) {
 34:     (*DMMGGetFine(dmmg)->computejacobian)(snes,X,J,B,flag,DMMGGetFine(dmmg));
 35:   } else {
 36:     PetscLogInfo(0,"DMMGComputeJacobian_Multigrid:Skipping Jacobian, SNES iteration %d frequence %d level %d\n",it,dmmg[nlevels-1]->updatejacobianperiod,nlevels-1);
 37:     *flag = SAME_PRECONDITIONER;
 38:   }
 39:   MatSNESMFSetBase(DMMGGetFine(dmmg)->J,X);

 41:   /* create coarser grid Jacobians for preconditioner if multigrid is the preconditioner */
 42:   SNESGetKSP(snes,&ksp);
 43:   KSPGetPC(ksp,&pc);
 44:   PetscTypeCompare((PetscObject)pc,PCMG,&ismg);
 45:   if (ismg) {

 47:     MGGetSmoother(pc,nlevels-1,&lksp);
 48:     KSPSetOperators(lksp,DMMGGetFine(dmmg)->J,DMMGGetFine(dmmg)->B,*flag);

 50:     if (dmmg[0]->galerkin) {
 51:       for (i=nlevels-2; i>-1; i--) {
 52:         PetscTruth JeqB = (PetscTruth)( dmmg[i]->B == dmmg[i]->J);
 53:         MatDestroy(dmmg[i]->B);
 54:         MatSeqAIJPtAP(dmmg[i+1]->B,dmmg[i+1]->R,&dmmg[i]->B);
 55:         if (JeqB) dmmg[i]->J = dmmg[i]->B;
 56:         MGGetSmoother(pc,i,&lksp);
 57:         KSPSetOperators(lksp,dmmg[i]->J,dmmg[i]->B,*flag);
 58:       }
 59:     } else {
 60:       for (i=nlevels-1; i>0; i--) {
 61:         if (!dmmg[i-1]->w) {
 62:           VecDuplicate(dmmg[i-1]->x,&dmmg[i-1]->w);
 63:         }
 64:         W    = dmmg[i-1]->w;
 65:         /* restrict X to coarser grid */
 66:         MatRestrict(dmmg[i]->R,X,W);
 67:         X    = W;
 68:         /* scale to "natural" scaling for that grid */
 69:         VecPointwiseMult(dmmg[i]->Rscale,X,X);
 70:         /* tell the base vector for matrix free multiplies */
 71:         MatSNESMFSetBase(dmmg[i-1]->J,X);
 72:         /* compute Jacobian on coarse grid */
 73:         if (dmmg[i-1]->updatejacobian && ShouldUpdate(i,it)) {
 74:           (*dmmg[i-1]->computejacobian)(snes,X,&dmmg[i-1]->J,&dmmg[i-1]->B,&flg,dmmg[i-1]);
 75:         } else {
 76:           PetscLogInfo(0,"DMMGComputeJacobian_Multigrid:Skipping Jacobian, SNES iteration %d frequence %d level %d\n",it,dmmg[i-1]->updatejacobianperiod,i-1);
 77:           flg = SAME_PRECONDITIONER;
 78:         }
 79:         MGGetSmoother(pc,i-1,&lksp);
 80:         KSPSetOperators(lksp,dmmg[i-1]->J,dmmg[i-1]->B,flg);
 81:       }
 82:     }
 83:   }
 84:   return(0);
 85: }

 87: /* ---------------------------------------------------------------------------*/

 91: /* 
 92:    DMMGFormFunction - This is a universal global FormFunction used by the DMMG code
 93:    when the user provides a local function.

 95:    Input Parameters:
 96: +  snes - the SNES context
 97: .  X - input vector
 98: -  ptr - optional user-defined context, as set by SNESSetFunction()

100:    Output Parameter:
101: .  F - function vector

103:  */
104: int DMMGFormFunction(SNES snes,Vec X,Vec F,void *ptr)
105: {
106:   DMMG             dmmg = (DMMG)ptr;
107:   int              ierr;
108:   Vec              localX;
109:   DA               da = (DA)dmmg->dm;

112:   DAGetLocalVector(da,&localX);
113:   /*
114:      Scatter ghost points to local vector, using the 2-step process
115:         DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
116:   */
117:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
118:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
119:   DAFormFunction1(da,localX,F,dmmg->user);
120:   DARestoreLocalVector(da,&localX);
121:   return(0);
122: }

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

131:    Collective on SNES

133:    Input Parameters:
134: +  snes - the SNES context
135: .  X - input vector
136: .  F - function vector
137: -  ptr - pointer to a structure that must have a DA as its first entry. For example this 
138:          could be a DMMG

140:    Level: intermediate

142: .seealso: DASetLocalFunction(), DASetLocalJacobian(), DASetLocalAdicFunction(), DASetLocalAdicMFFunction(),
143:           SNESSetFunction(), SNESSetJacobian()

145: @*/
146: int SNESDAFormFunction(SNES snes,Vec X,Vec F,void *ptr)
147: {
148:   int              ierr;
149:   Vec              localX;
150:   DA               da = *(DA*)ptr;

153:   DAGetLocalVector(da,&localX);
154:   /*
155:      Scatter ghost points to local vector, using the 2-step process
156:         DAGlobalToLocalBegin(), DAGlobalToLocalEnd().
157:   */
158:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
159:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
160:   DAFormFunction1(da,localX,F,ptr);
161:   DARestoreLocalVector(da,&localX);
162:   return(0);
163: }

165: /* ---------------------------------------------------------------------------------------------------------------------------*/

169: int DMMGComputeJacobianWithFD(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
170: {
171:   int  ierr;
172:   DMMG dmmg = (DMMG)ctx;
173: 
175:   SNESDefaultComputeJacobianColor(snes,x1,J,B,flag,dmmg->fdcoloring);
176:   return(0);
177: }

181: int DMMGComputeJacobianWithMF(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
182: {
183:   int  ierr;
184: 
186:   MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
187:   MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
188:   return(0);
189: }

193: /*
194:     DMMGComputeJacobianWithAdic - Evaluates the Jacobian via Adic when the user has provided
195:     a local function evaluation routine.
196: */
197: int DMMGComputeJacobianWithAdic(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
198: {
199:   DMMG             dmmg = (DMMG) ptr;
200:   int              ierr;
201:   Vec              localX;
202:   DA               da = (DA) dmmg->dm;

205:   DAGetLocalVector(da,&localX);
206:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
207:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
208:   DAComputeJacobian1WithAdic(da,localX,*B,dmmg->user);
209:   DARestoreLocalVector(da,&localX);
210:   /* Assemble true Jacobian; if it is different */
211:   if (*J != *B) {
212:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
213:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
214:   }
215:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
216:   *flag = SAME_NONZERO_PATTERN;
217:   return(0);
218: }

222: /*@
223:     SNESDAComputeJacobianWithAdic - This is a universal Jacobian evaluation routine
224:     that may be used with SNESSetJacobian() as long as the user context has a DA as
225:     its first record and DASetLocalAdicFunction() has been called.  

227:    Collective on SNES

229:    Input Parameters:
230: +  snes - the SNES context
231: .  X - input vector
232: .  J - Jacobian
233: .  B - Jacobian used in preconditioner (usally same as J)
234: .  flag - indicates if the matrix changed its structure
235: -  ptr - optional user-defined context, as set by SNESSetFunction()

237:    Level: intermediate

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

241: @*/
242: int SNESDAComputeJacobianWithAdic(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
243: {
244:   DA   da = *(DA*) ptr;
245:   int  ierr;
246:   Vec  localX;

249:   DAGetLocalVector(da,&localX);
250:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
251:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
252:   DAComputeJacobian1WithAdic(da,localX,*B,ptr);
253:   DARestoreLocalVector(da,&localX);
254:   /* Assemble true Jacobian; if it is different */
255:   if (*J != *B) {
256:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
257:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
258:   }
259:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
260:   *flag = SAME_NONZERO_PATTERN;
261:   return(0);
262: }

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

271:    Collective on SNES

273:    Input Parameters:
274: +  snes - the SNES context
275: .  X - input vector
276: .  J - Jacobian
277: .  B - Jacobian used in preconditioner (usally same as J)
278: .  flag - indicates if the matrix changed its structure
279: -  ptr - optional user-defined context, as set by SNESSetFunction()

281:    Level: intermediate

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

285: */
286: int SNESDAComputeJacobianWithAdifor(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
287: {
288:   DA   da = *(DA*) ptr;
289:   int  ierr;
290:   Vec  localX;

293:   DAGetLocalVector(da,&localX);
294:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
295:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
296:   DAComputeJacobian1WithAdifor(da,localX,*B,ptr);
297:   DARestoreLocalVector(da,&localX);
298:   /* Assemble true Jacobian; if it is different */
299:   if (*J != *B) {
300:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
301:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
302:   }
303:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
304:   *flag = SAME_NONZERO_PATTERN;
305:   return(0);
306: }

310: /*
311:    SNESDAComputeJacobian - This is a universal Jacobian evaluation routine for a
312:    locally provided Jacobian.

314:    Collective on SNES

316:    Input Parameters:
317: +  snes - the SNES context
318: .  X - input vector
319: .  J - Jacobian
320: .  B - Jacobian used in preconditioner (usally same as J)
321: .  flag - indicates if the matrix changed its structure
322: -  ptr - optional user-defined context, as set by SNESSetFunction()

324:    Level: intermediate

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

328: */
329: int SNESDAComputeJacobian(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flag,void *ptr)
330: {
331:   DA   da = *(DA*) ptr;
332:   int  ierr;
333:   Vec  localX;

336:   DAGetLocalVector(da,&localX);
337:   DAGlobalToLocalBegin(da,X,INSERT_VALUES,localX);
338:   DAGlobalToLocalEnd(da,X,INSERT_VALUES,localX);
339:   DAComputeJacobian1(da,localX,*B,ptr);
340:   DARestoreLocalVector(da,&localX);
341:   /* Assemble true Jacobian; if it is different */
342:   if (*J != *B) {
343:     MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);
344:     MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);
345:   }
346:   MatSetOption(*B,MAT_NEW_NONZERO_LOCATION_ERR);
347:   *flag = SAME_NONZERO_PATTERN;
348:   return(0);
349: }

353: int DMMGSolveSNES(DMMG *dmmg,int level)
354: {
355:   int  ierr,nlevels = dmmg[0]->nlevels;

358:   dmmg[0]->nlevels = level+1;
359:   SNESSolve(dmmg[level]->snes,dmmg[level]->x);
360:   dmmg[0]->nlevels = nlevels;
361:   return(0);
362: }

364: EXTERN_C_BEGIN
365: extern int NLFCreate_DAAD(NLF*);
366: extern int NLFRelax_DAAD(NLF,MatSORType,int,Vec);
367: extern int NLFDAADSetDA_DAAD(NLF,DA);
368: extern int NLFDAADSetCtx_DAAD(NLF,void*);
369: extern int NLFDAADSetResidual_DAAD(NLF,Vec);
370: extern int NLFDAADSetNewtonIterations_DAAD(NLF,int);
371: EXTERN_C_END

373: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
374:  #include src/ksp/pc/impls/mg/mgimpl.h
375: /*
376:           This is pre-beta FAS code. It's design should not be taken seriously!
377: */
380: int DMMGSolveFAS(DMMG *dmmg,int level)
381: {
382:   int         ierr,i,j,k;
383:   PetscReal   norm;
384:   PetscScalar zero = 0.0,mone = -1.0,one = 1.0;
385:   MG          *mg;
386:   PC          pc;
387:   KSP         ksp;

390:   VecSet(&zero,dmmg[level]->r);
391:   for (j=1; j<=level; j++) {
392:     if (!dmmg[j]->inject) {
393:       DMGetInjection(dmmg[j-1]->dm,dmmg[j]->dm,&dmmg[j]->inject);
394:     }
395:   }

397:   SNESGetKSP(dmmg[level]->snes,&ksp);
398:   KSPGetPC(ksp,&pc);
399:   mg   = ((MG*)pc->data);

401:   for (i=0; i<100; i++) {

403:     for (j=level; j>0; j--) {

405:       /* Relax residual_fine - F(x_fine) = 0 */
406:       for (k=0; k<dmmg[j]->presmooth; k++) {
407:         NLFRelax_DAAD(dmmg[j]->nlf,SOR_SYMMETRIC_SWEEP,1,dmmg[j]->x);
408:       }

410:       /* R*(residual_fine - F(x_fine)) */
411:       DMMGFormFunction(0,dmmg[j]->x,dmmg[j]->w,dmmg[j]);
412:       VecAYPX(&mone,dmmg[j]->r,dmmg[j]->w);

414:       if (j == level || dmmg[j]->monitorall) {
415:         /* norm( residual_fine - f(x_fine) ) */
416:         VecNorm(dmmg[j]->w,NORM_2,&norm);
417:         if (j == level) {
418:           if (norm < dmmg[level]->atol) goto theend;
419:           if (i == 0) {
420:             dmmg[level]->rrtol = norm*dmmg[level]->rtol;
421:           } else {
422:             if (norm < dmmg[level]->rrtol) goto theend;
423:           }
424:         }
425:       }

427:       if (dmmg[j]->monitorall) {
428:         for (k=0; k<level-j+1; k++) {PetscPrintf(dmmg[j]->comm,"  ");}
429:         PetscPrintf(dmmg[j]->comm,"FAS function norm %g\n",norm);
430:       }
431:       MatRestrict(mg[j]->restrct,dmmg[j]->w,dmmg[j-1]->r);
432: 
433:       /* F(R*x_fine) */
434:       VecScatterBegin(dmmg[j]->x,dmmg[j-1]->x,INSERT_VALUES,SCATTER_FORWARD,dmmg[j]->inject);
435:       VecScatterEnd(dmmg[j]->x,dmmg[j-1]->x,INSERT_VALUES,SCATTER_FORWARD,dmmg[j]->inject);
436:       DMMGFormFunction(0,dmmg[j-1]->x,dmmg[j-1]->w,dmmg[j-1]);

438:       /* residual_coarse = F(R*x_fine) + R*(residual_fine - F(x_fine)) */
439:       VecAYPX(&one,dmmg[j-1]->w,dmmg[j-1]->r);

441:       /* save R*x_fine into b (needed when interpolating compute x back up */
442:       VecCopy(dmmg[j-1]->x,dmmg[j-1]->b);
443:     }

445:     for (j=0; j<dmmg[0]->presmooth; j++) {
446:       NLFRelax_DAAD(dmmg[0]->nlf,SOR_SYMMETRIC_SWEEP,1,dmmg[0]->x);
447:     }
448:     if (dmmg[0]->monitorall){
449:       DMMGFormFunction(0,dmmg[0]->x,dmmg[0]->w,dmmg[0]);
450:       VecAXPY(&mone,dmmg[0]->r,dmmg[0]->w);
451:       VecNorm(dmmg[0]->w,NORM_2,&norm);
452:       for (k=0; k<level+1; k++) {PetscPrintf(dmmg[0]->comm,"  ");}
453:       PetscPrintf(dmmg[0]->comm,"FAS coarse grid function norm %g\n",norm);
454:     }

456:     for (j=1; j<=level; j++) {
457:       /* x_fine = x_fine + R'*(x_coarse - R*x_fine) */
458:       VecAXPY(&mone,dmmg[j-1]->b,dmmg[j-1]->x);
459:       MatInterpolateAdd(mg[j]->restrct,dmmg[j-1]->x,dmmg[j]->x,dmmg[j]->x);

461:       if (dmmg[j]->monitorall) {
462:         /* norm( F(x_fine) - residual_fine ) */
463:         DMMGFormFunction(0,dmmg[j]->x,dmmg[j]->w,dmmg[j]);
464:         VecAXPY(&mone,dmmg[j]->r,dmmg[j]->w);
465:         VecNorm(dmmg[j]->w,NORM_2,&norm);
466:         for (k=0; k<level-j+1; k++) {PetscPrintf(dmmg[j]->comm,"  ");}
467:         PetscPrintf(dmmg[j]->comm,"FAS function norm %g\n",norm);
468:       }

470:       /* Relax residual_fine - F(x_fine)  = 0 */
471:       for (k=0; k<dmmg[j]->postsmooth; k++) {
472:         NLFRelax_DAAD(dmmg[j]->nlf,SOR_SYMMETRIC_SWEEP,1,dmmg[j]->x);
473:       }

475:       if (dmmg[j]->monitorall) {
476:         /* norm( F(x_fine) - residual_fine ) */
477:         DMMGFormFunction(0,dmmg[j]->x,dmmg[j]->w,dmmg[j]);
478:         VecAXPY(&mone,dmmg[j]->r,dmmg[j]->w);
479:         VecNorm(dmmg[j]->w,NORM_2,&norm);
480:         for (k=0; k<level-j+1; k++) {PetscPrintf(dmmg[j]->comm,"  ");}
481:         PetscPrintf(dmmg[j]->comm,"FAS function norm %g\n",norm);
482:       }
483:     }

485:     if (dmmg[level]->monitor){
486:       DMMGFormFunction(0,dmmg[level]->x,dmmg[level]->w,dmmg[level]);
487:       VecNorm(dmmg[level]->w,NORM_2,&norm);
488:       PetscPrintf(dmmg[level]->comm,"%d FAS function norm %g\n",i,norm);
489:     }
490:   }
491:   theend:
492:   return(0);
493: }
494: #endif

496: /* ===========================================================================================================*/

500: /*@C
501:     DMMGSetSNES - Sets the nonlinear function that defines the nonlinear set of equations
502:     to be solved using the grid hierarchy.

504:     Collective on DMMG

506:     Input Parameter:
507: +   dmmg - the context
508: .   function - the function that defines the nonlinear system
509: -   jacobian - optional function to compute Jacobian

511:     Options Database Keys:
512: +    -dmmg_snes_monitor
513: .    -dmmg_jacobian_fd
514: .    -dmmg_jacobian_ad
515: .    -dmmg_jacobian_mf_fd_operator
516: .    -dmmg_jacobian_mf_fd
517: .    -dmmg_jacobian_mf_ad_operator
518: .    -dmmg_jacobian_mf_ad
519: -    -dmmg_jacobian_period <p> - Indicates how often in the SNES solve the Jacobian is recomputed (on all levels)
520:                                  as suggested by Florin Dobrian if p is -1 then Jacobian is computed only on first
521:                                  SNES iteration (i.e. -1 is equivalent to infinity) 

523:     Level: advanced

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

527: @*/
528: int DMMGSetSNES(DMMG *dmmg,int (*function)(SNES,Vec,Vec,void*),int (*jacobian)(SNES,Vec,Mat*,Mat*,MatStructure*,void*))
529: {
530:   int         ierr,size,i,nlevels = dmmg[0]->nlevels,period = 1;
531:   PetscTruth  snesmonitor,mffdoperator,mffd,fdjacobian;
532: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
533:   PetscTruth  mfadoperator,mfad,adjacobian;
534: #endif
535:   KSP        ksp;
536:   PetscViewer ascii;
537:   MPI_Comm    comm;

540:   if (!dmmg)     SETERRQ(1,"Passing null as DMMG");
541:   if (!jacobian) jacobian = DMMGComputeJacobianWithFD;

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


547:     PetscOptionsName("-dmmg_jacobian_fd","Compute sparse Jacobian explicitly with finite differencing","DMMGSetSNES",&fdjacobian);
548:     if (fdjacobian) jacobian = DMMGComputeJacobianWithFD;
549: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
550:     PetscOptionsName("-dmmg_jacobian_ad","Compute sparse Jacobian explicitly with ADIC (automatic differentiation)","DMMGSetSNES",&adjacobian);
551:     if (adjacobian) jacobian = DMMGComputeJacobianWithAdic;
552: #endif

554:     PetscOptionsLogicalGroupBegin("-dmmg_jacobian_mf_fd_operator","Apply Jacobian via matrix free finite differencing","DMMGSetSNES",&mffdoperator);
555:     PetscOptionsLogicalGroupEnd("-dmmg_jacobian_mf_fd","Apply Jacobian via matrix free finite differencing even in computing preconditioner","DMMGSetSNES",&mffd);
556:     if (mffd) mffdoperator = PETSC_TRUE;
557: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
558:     PetscOptionsLogicalGroupBegin("-dmmg_jacobian_mf_ad_operator","Apply Jacobian via matrix free ADIC (automatic differentiation)","DMMGSetSNES",&mfadoperator);
559:     PetscOptionsLogicalGroupEnd("-dmmg_jacobian_mf_ad","Apply Jacobian via matrix free ADIC (automatic differentiation) even in computing preconditioner","DMMGSetSNES",&mfad);
560:     if (mfad) mfadoperator = PETSC_TRUE;
561: #endif
562:   PetscOptionsEnd();

564:   /* create solvers for each level */
565:   for (i=0; i<nlevels; i++) {
566:     SNESCreate(dmmg[i]->comm,&dmmg[i]->snes);
567:     if (snesmonitor) {
568:       PetscObjectGetComm((PetscObject)dmmg[i]->snes,&comm);
569:       PetscViewerASCIIOpen(comm,"stdout",&ascii);
570:       PetscViewerASCIISetTab(ascii,nlevels-i);
571:       SNESSetMonitor(dmmg[i]->snes,SNESDefaultMonitor,ascii,(int(*)(void*))PetscViewerDestroy);
572:     }

574:     if (mffdoperator) {
575:       MatCreateSNESMF(dmmg[i]->snes,dmmg[i]->x,&dmmg[i]->J);
576:       VecDuplicate(dmmg[i]->x,&dmmg[i]->work1);
577:       VecDuplicate(dmmg[i]->x,&dmmg[i]->work2);
578:       MatSNESMFSetFunction(dmmg[i]->J,dmmg[i]->work1,function,dmmg[i]);
579:       if (mffd) {
580:         dmmg[i]->B = dmmg[i]->J;
581:         jacobian   = DMMGComputeJacobianWithMF;
582:       }
583: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
584:     } else if (mfadoperator) {
585:       MatRegisterDAAD();
586:       MatCreateDAAD((DA)dmmg[i]->dm,&dmmg[i]->J);
587:       MatDAADSetCtx(dmmg[i]->J,dmmg[i]->user);
588:       if (mfad) {
589:         dmmg[i]->B = dmmg[i]->J;
590:         jacobian   = DMMGComputeJacobianWithMF;
591:       }
592: #endif
593:     }
594: 
595:     if (!dmmg[i]->B) {
596:       MPI_Comm_size(dmmg[i]->comm,&size);
597:       DMGetMatrix(dmmg[i]->dm,MATAIJ,&dmmg[i]->B);
598:     }
599:     if (!dmmg[i]->J) {
600:       dmmg[i]->J = dmmg[i]->B;
601:     }

603:     SNESGetKSP(dmmg[i]->snes,&ksp);
604:     DMMGSetUpLevel(dmmg,ksp,i+1);
605: 
606:     /*
607:        if the number of levels is > 1 then we want the coarse solve in the grid sequencing to use LU
608:        when possible 
609:     */
610:     if (nlevels > 1 && i == 0) {
611:       PC         pc;
612:       KSP        cksp;
613:       PetscTruth flg1,flg2,flg3;

615:       KSPGetPC(ksp,&pc);
616:       MGGetCoarseSolve(pc,&cksp);
617:       KSPGetPC(cksp,&pc);
618:       PetscTypeCompare((PetscObject)pc,PCILU,&flg1);
619:       PetscTypeCompare((PetscObject)pc,PCSOR,&flg2);
620:       PetscTypeCompare((PetscObject)pc,PETSC_NULL,&flg3);
621:       if (flg1 || flg2 || flg3) {
622:         PCSetType(pc,PCLU);
623:       }
624:     }

626:     SNESSetFromOptions(dmmg[i]->snes);
627:     dmmg[i]->solve           = DMMGSolveSNES;
628:     dmmg[i]->computejacobian = jacobian;
629:     dmmg[i]->computefunction = function;
630:   }


633:   if (jacobian == DMMGComputeJacobianWithFD) {
634:     ISColoring iscoloring;
635:     for (i=0; i<nlevels; i++) {
636:       DMGetColoring(dmmg[i]->dm,IS_COLORING_LOCAL,&iscoloring);
637:       MatFDColoringCreate(dmmg[i]->B,iscoloring,&dmmg[i]->fdcoloring);
638:       ISColoringDestroy(iscoloring);
639:       MatFDColoringSetFunction(dmmg[i]->fdcoloring,(int(*)(void))function,dmmg[i]);
640:       MatFDColoringSetFromOptions(dmmg[i]->fdcoloring);
641:     }
642: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
643:   } else if (jacobian == DMMGComputeJacobianWithAdic) {
644:     for (i=0; i<nlevels; i++) {
645:       ISColoring iscoloring;
646:       DMGetColoring(dmmg[i]->dm,IS_COLORING_GHOSTED,&iscoloring);
647:       MatSetColoring(dmmg[i]->B,iscoloring);
648:       ISColoringDestroy(iscoloring);
649:     }
650: #endif
651:   }

653:   for (i=0; i<nlevels; i++) {
654:     SNESSetJacobian(dmmg[i]->snes,dmmg[i]->J,dmmg[i]->B,DMMGComputeJacobian_Multigrid,dmmg);
655:     SNESSetFunction(dmmg[i]->snes,dmmg[i]->b,function,dmmg[i]);
656:   }

658:   /* Create interpolation scaling */
659:   for (i=1; i<nlevels; i++) {
660:     DMGetInterpolationScale(dmmg[i-1]->dm,dmmg[i]->dm,dmmg[i]->R,&dmmg[i]->Rscale);
661:   }

663:   PetscOptionsGetInt(PETSC_NULL,"-dmmg_jacobian_period",&period,PETSC_NULL);
664:   for (i=0; i<nlevels; i++) {
665:     dmmg[i]->updatejacobian       = PETSC_TRUE;
666:     dmmg[i]->updatejacobianperiod = period;
667:   }

669: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
670:   {
671:     PetscTruth flg;
672:     PetscOptionsHasName(PETSC_NULL,"-dmmg_fas",&flg);
673:     if (flg) {
674:       int newton_its;
675:       PetscOptionsHasName(0,"-fas_view",&flg);
676:       for (i=0; i<nlevels; i++) {
677:         NLFCreate_DAAD(&dmmg[i]->nlf);
678:         NLFDAADSetDA_DAAD(dmmg[i]->nlf,(DA)dmmg[i]->dm);
679:         NLFDAADSetCtx_DAAD(dmmg[i]->nlf,dmmg[i]->user);
680:         NLFDAADSetResidual_DAAD(dmmg[i]->nlf,dmmg[i]->r);
681:         VecDuplicate(dmmg[i]->b,&dmmg[i]->w);

683:         dmmg[i]->monitor    = PETSC_FALSE;
684:         PetscOptionsHasName(0,"-dmmg_fas_monitor",&dmmg[i]->monitor);
685:         dmmg[i]->monitorall = PETSC_FALSE;
686:         PetscOptionsHasName(0,"-dmmg_fas_monitor_all",&dmmg[i]->monitorall);
687:         dmmg[i]->presmooth  = 2;
688:         PetscOptionsGetInt(0,"-dmmg_fas_presmooth",&dmmg[i]->presmooth,0);
689:         dmmg[i]->postsmooth = 2;
690:         PetscOptionsGetInt(0,"-dmmg_fas_postsmooth",&dmmg[i]->postsmooth,0);
691:         dmmg[i]->coarsesmooth = 2;
692:         PetscOptionsGetInt(0,"-dmmg_fas_coarsesmooth",&dmmg[i]->coarsesmooth,0);

694:         dmmg[i]->rtol = 1.e-8;
695:         PetscOptionsGetReal(0,"-dmmg_fas_rtol",&dmmg[i]->rtol,0);
696:         dmmg[i]->atol = 1.e-50;
697:         PetscOptionsGetReal(0,"-dmmg_fas_atol",&dmmg[i]->atol,0);

699:         newton_its = 2;
700:         PetscOptionsGetInt(0,"-dmmg_fas_newton_its",&newton_its,0);
701:         NLFDAADSetNewtonIterations_DAAD(dmmg[i]->nlf,newton_its);

703:         if (flg) {
704:           if (i == 0) {
705:             PetscPrintf(dmmg[i]->comm,"FAS Solver Parameters\n");
706:             PetscPrintf(dmmg[i]->comm,"  rtol %g atol %g\n",dmmg[i]->rtol,dmmg[i]->atol);
707:             PetscPrintf(dmmg[i]->comm,"             coarsesmooths %d\n",dmmg[i]->coarsesmooth);
708:             PetscPrintf(dmmg[i]->comm,"             Newton iterations %d\n",newton_its);
709:           } else {
710:             PetscPrintf(dmmg[i]->comm,"  level %d   presmooths    %d\n",i,dmmg[i]->presmooth);
711:             PetscPrintf(dmmg[i]->comm,"             postsmooths   %d\n",dmmg[i]->postsmooth);
712:             PetscPrintf(dmmg[i]->comm,"             Newton iterations %d\n",newton_its);
713:           }
714:         }
715:         dmmg[i]->solve = DMMGSolveFAS;
716:       }
717:     }
718:   }
719: #endif
720: 
721:   return(0);
722: }

726: /*@C
727:     DMMGSetInitialGuess - Sets the function that computes an initial guess, if not given
728:     uses 0.

730:     Collective on DMMG and SNES

732:     Input Parameter:
733: +   dmmg - the context
734: -   guess - the function

736:     Level: advanced

738: .seealso DMMGCreate(), DMMGDestroy, DMMGSetKSP()

740: @*/
741: int DMMGSetInitialGuess(DMMG *dmmg,int (*guess)(SNES,Vec,void*))
742: {
743:   int i,nlevels = dmmg[0]->nlevels;

746:   for (i=0; i<nlevels; i++) {
747:     dmmg[i]->initialguess = guess;
748:   }
749:   return(0);
750: }

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

756:     Collective on DMMG

758:    Synopsis:
759:    int DMMGSetSNESLocal(DMMG *dmmg,DALocalFunction1 function, DALocalFunction1 jacobian,
760:                         DALocalFunction1 ad_function, DALocalFunction1 admf_function);

762:     Input Parameter:
763: +   dmmg - the context
764: .   function - the function that defines the nonlinear system
765: .   jacobian - function defines the local part of the Jacobian (not currently supported)
766: .   ad_function - the name of the function with an ad_ prefix. This is ignored if ADIC is
767:                   not installed
768: -   admf_function - the name of the function with an ad_ prefix. This is ignored if ADIC is
769:                   not installed

771:     Options Database Keys:
772: +    -dmmg_snes_monitor
773: .    -dmmg_jacobian_fd
774: .    -dmmg_jacobian_ad
775: .    -dmmg_jacobian_mf_fd_operator
776: .    -dmmg_jacobian_mf_fd
777: .    -dmmg_jacobian_mf_ad_operator
778: .    -dmmg_jacobian_mf_ad
779: -    -dmmg_jacobian_period <p> - Indicates how often in the SNES solve the Jacobian is recomputed (on all levels)
780:                                  as suggested by Florin Dobrian if p is -1 then Jacobian is computed only on first
781:                                  SNES iteration (i.e. -1 is equivalent to infinity) 


784:     Level: intermediate

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

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

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

796: M*/

800: int DMMGSetSNESLocal_Private(DMMG *dmmg,DALocalFunction1 function,DALocalFunction1 jacobian,DALocalFunction1 ad_function,DALocalFunction1 admf_function)
801: {
802:   int ierr,i,nlevels = dmmg[0]->nlevels;
803:   int (*computejacobian)(SNES,Vec,Mat*,Mat*,MatStructure*,void*) = 0;


807:   if (jacobian)         computejacobian = SNESDAComputeJacobian;
808: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
809:   else if (ad_function) computejacobian = DMMGComputeJacobianWithAdic;
810: #endif

812:   DMMGSetSNES(dmmg,DMMGFormFunction,computejacobian);
813:   for (i=0; i<nlevels; i++) {
814:     DASetLocalFunction((DA)dmmg[i]->dm,function);
815:     DASetLocalJacobian((DA)dmmg[i]->dm,jacobian);
816:     DASetLocalAdicFunction((DA)dmmg[i]->dm,ad_function);
817:     DASetLocalAdicMFFunction((DA)dmmg[i]->dm,admf_function);
818:   }
819:   return(0);
820: }

824: static int DMMGFunctioni(int i,Vec u,PetscScalar* r,void* ctx)
825: {
826:   DMMG       dmmg = (DMMG)ctx;
827:   Vec        U = dmmg->lwork1;
828:   int        ierr;
829:   VecScatter gtol;

832:   /* copy u into interior part of U */
833:   DAGetScatter((DA)dmmg->dm,0,&gtol,0);
834:   VecScatterBegin(u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL,gtol);
835:   VecScatterEnd(u,U,INSERT_VALUES,SCATTER_FORWARD_LOCAL,gtol);
836:   DAFormFunctioni1((DA)dmmg->dm,i,U,r,dmmg->user);
837:   return(0);
838: }

842: static int DMMGFunctioniBase(Vec u,void* ctx)
843: {
844:   DMMG dmmg = (DMMG)ctx;
845:   Vec  U = dmmg->lwork1;
846:   int  ierr;

849:   DAGlobalToLocalBegin((DA)dmmg->dm,u,INSERT_VALUES,U);
850:   DAGlobalToLocalEnd((DA)dmmg->dm,u,INSERT_VALUES,U);
851:   return(0);
852: }

856: int DMMGSetSNESLocali_Private(DMMG *dmmg,int (*functioni)(DALocalInfo*,MatStencil*,void*,PetscScalar*,void*),int (*adi)(DALocalInfo*,MatStencil*,void*,void*,void*),int (*adimf)(DALocalInfo*,MatStencil*,void*,void*,void*))
857: {
858:   int ierr,i,nlevels = dmmg[0]->nlevels;

861:   for (i=0; i<nlevels; i++) {
862:     DASetLocalFunctioni((DA)dmmg[i]->dm,functioni);
863:     DASetLocalAdicFunctioni((DA)dmmg[i]->dm,adi);
864:     DASetLocalAdicMFFunctioni((DA)dmmg[i]->dm,adimf);
865:     MatSNESMFSetFunctioni(dmmg[i]->J,DMMGFunctioni);
866:     MatSNESMFSetFunctioniBase(dmmg[i]->J,DMMGFunctioniBase);
867:     DACreateLocalVector((DA)dmmg[i]->dm,&dmmg[i]->lwork1);
868:   }
869:   return(0);
870: }


873: #if defined(PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
874: EXTERN_C_BEGIN
875: #include "adic/ad_utils.h"
876: EXTERN_C_END

880: int PetscADView(int N,int nc,double *ptr,PetscViewer viewer)
881: {
882:   int        i,j,nlen  = PetscADGetDerivTypeSize();
883:   char       *cptr = (char*)ptr;
884:   double     *values;

887:   for (i=0; i<N; i++) {
888:     printf("Element %d value %g derivatives: ",i,*(double*)cptr);
889:     values = PetscADGetGradArray(cptr);
890:     for (j=0; j<nc; j++) {
891:       printf("%g ",*values++);
892:     }
893:     printf("\n");
894:     cptr += nlen;
895:   }

897:   return(0);
898: }

900: #endif