xref: /petsc/src/snes/impls/fas/fas.c (revision e856ceec863ef703e49eb5c04ffcf8aa49e2215c)
1 /* Defines the basic SNES object */
2 #include <../src/snes/impls/fas/fasimpls.h>    /*I  "petscsnesfas.h"  I*/
3 
4 const char *SNESFASTypes[] = {"MULTIPLICATIVE","ADDITIVE","SNESFASType","SNES_FAS",0};
5 
6 /*MC
7 
8 SNESFAS - Full Approximation Scheme nonlinear multigrid solver.
9 
10 The nonlinear problem is solved via the repeated application of nonlinear preconditioners and coarse-grid corrections
11 
12 .seealso: SNESCreate(), SNES, SNESSetType(), SNESType (for list of available types)
13 M*/
14 
15 extern PetscErrorCode SNESDestroy_FAS(SNES snes);
16 extern PetscErrorCode SNESSetUp_FAS(SNES snes);
17 extern PetscErrorCode SNESSetFromOptions_FAS(SNES snes);
18 extern PetscErrorCode SNESView_FAS(SNES snes, PetscViewer viewer);
19 extern PetscErrorCode SNESSolve_FAS(SNES snes);
20 extern PetscErrorCode SNESReset_FAS(SNES snes);
21 extern PetscErrorCode SNESFASGalerkinDefaultFunction(SNES, Vec, Vec, void *);
22 
23 EXTERN_C_BEGIN
24 #undef __FUNCT__
25 #define __FUNCT__ "SNESLineSearchSetType_FAS"
26 PetscErrorCode  SNESLineSearchSetType_FAS(SNES snes, SNESLineSearchType type)
27 {
28   PetscErrorCode ierr;
29   PetscFunctionBegin;
30 
31   switch (type) {
32   case SNES_LS_BASIC:
33     ierr = SNESLineSearchSet(snes,SNESLineSearchNo,PETSC_NULL);CHKERRQ(ierr);
34     break;
35   case SNES_LS_BASIC_NONORMS:
36     ierr = SNESLineSearchSet(snes,SNESLineSearchNoNorms,PETSC_NULL);CHKERRQ(ierr);
37     break;
38   case SNES_LS_QUADRATIC:
39     ierr = SNESLineSearchSet(snes,SNESLineSearchQuadraticSecant,PETSC_NULL);CHKERRQ(ierr);
40     break;
41   default:
42     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP,"Unknown line search type.");
43     break;
44   }
45   snes->ls_type = type;
46   PetscFunctionReturn(0);
47 }
48 EXTERN_C_END
49 
50 EXTERN_C_BEGIN
51 
52 #undef __FUNCT__
53 #define __FUNCT__ "SNESCreate_FAS"
54 PetscErrorCode SNESCreate_FAS(SNES snes)
55 {
56   SNES_FAS * fas;
57   PetscErrorCode ierr;
58 
59   PetscFunctionBegin;
60   snes->ops->destroy        = SNESDestroy_FAS;
61   snes->ops->setup          = SNESSetUp_FAS;
62   snes->ops->setfromoptions = SNESSetFromOptions_FAS;
63   snes->ops->view           = SNESView_FAS;
64   snes->ops->solve          = SNESSolve_FAS;
65   snes->ops->reset          = SNESReset_FAS;
66 
67   snes->usesksp             = PETSC_FALSE;
68   snes->usespc              = PETSC_FALSE;
69 
70   ierr = PetscNewLog(snes, SNES_FAS, &fas);CHKERRQ(ierr);
71   snes->data                  = (void*) fas;
72   fas->level                  = 0;
73   fas->levels                 = 1;
74   fas->n_cycles               = 1;
75   fas->max_up_it              = 1;
76   fas->max_down_it            = 1;
77   fas->upsmooth               = PETSC_NULL;
78   fas->downsmooth             = PETSC_NULL;
79   fas->next                   = PETSC_NULL;
80   fas->previous               = PETSC_NULL;
81   fas->interpolate            = PETSC_NULL;
82   fas->restrct                = PETSC_NULL;
83   fas->inject                 = PETSC_NULL;
84   fas->monitor                = PETSC_NULL;
85   fas->usedmfornumberoflevels = PETSC_FALSE;
86   fas->fastype                = SNES_FAS_MULTIPLICATIVE;
87 
88   ierr = PetscObjectComposeFunctionDynamic((PetscObject)snes,"SNESLineSearchSetType_C","SNESLineSearchSetType_FAS",SNESLineSearchSetType_FAS);CHKERRQ(ierr);
89   ierr = SNESLineSearchSetType(snes, SNES_LS_QUADRATIC);CHKERRQ(ierr);
90 
91   PetscFunctionReturn(0);
92 }
93 EXTERN_C_END
94 
95 #undef __FUNCT__
96 #define __FUNCT__ "SNESFASGetLevels"
97 /*@
98    SNESFASGetLevels - Gets the number of levels in a FAS.
99 
100    Input Parameter:
101 .  snes - the preconditioner context
102 
103    Output parameter:
104 .  levels - the number of levels
105 
106    Level: advanced
107 
108 .keywords: MG, get, levels, multigrid
109 
110 .seealso: SNESFASSetLevels(), PCMGGetLevels()
111 @*/
112 PetscErrorCode SNESFASGetLevels(SNES snes, PetscInt * levels) {
113   SNES_FAS * fas = (SNES_FAS *)snes->data;
114   PetscFunctionBegin;
115   *levels = fas->levels;
116   PetscFunctionReturn(0);
117 }
118 
119 #undef __FUNCT__
120 #define __FUNCT__ "SNESFASSetCycles"
121 /*@
122    SNESFASSetCycles - Sets the type cycles to use.  Use SNESFASSetCyclesOnLevel() for more
123    complicated cycling.
124 
125    Logically Collective on SNES
126 
127    Input Parameters:
128 +  snes   - the multigrid context
129 -  cycles - the number of cycles -- 1 for V-cycle, 2 for W-cycle
130 
131    Options Database Key:
132 $  -snes_fas_cycles 1 or 2
133 
134    Level: advanced
135 
136 .keywords: MG, set, cycles, V-cycle, W-cycle, multigrid
137 
138 .seealso: SNESFASSetCyclesOnLevel()
139 @*/
140 PetscErrorCode SNESFASSetCycles(SNES snes, PetscInt cycles) {
141   SNES_FAS * fas = (SNES_FAS *)snes->data;
142   PetscErrorCode ierr;
143   PetscFunctionBegin;
144   fas->n_cycles = cycles;
145   if (fas->next) {
146     ierr = SNESFASSetCycles(fas->next, cycles);CHKERRQ(ierr);
147   }
148   PetscFunctionReturn(0);
149 }
150 
151 #undef __FUNCT__
152 #define __FUNCT__ "SNESFASSetCyclesOnLevel"
153 /*@
154    SNESFASSetCyclesOnLevel - Sets the type cycles to use on a particular level.
155 
156    Logically Collective on SNES
157 
158    Input Parameters:
159 +  snes   - the multigrid context
160 .  level  - the level to set the number of cycles on
161 -  cycles - the number of cycles -- 1 for V-cycle, 2 for W-cycle
162 
163    Level: advanced
164 
165 .keywords: MG, set, cycles, V-cycle, W-cycle, multigrid
166 
167 .seealso: SNESFASSetCycles()
168 @*/
169 PetscErrorCode SNESFASSetCyclesOnLevel(SNES snes, PetscInt level, PetscInt cycles) {
170   SNES_FAS * fas =  (SNES_FAS *)snes->data;
171   PetscInt top_level = fas->level,i;
172 
173   PetscFunctionBegin;
174   if (level > top_level)
175     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetCyclesOnLevel", level);
176   /* get to the correct level */
177   for (i = fas->level; i > level; i--) {
178     fas = (SNES_FAS *)fas->next->data;
179   }
180   if (fas->level != level)
181     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetCyclesOnLevel");
182   fas->n_cycles = cycles;
183   PetscFunctionReturn(0);
184 }
185 
186 #undef __FUNCT__
187 #define __FUNCT__ "SNESFASSetGS"
188 /*@C
189    SNESFASSetGS - Sets a nonlinear GS smoother and if it should be used.
190    Use SNESFASSetGSOnLevel() for more complicated staging of smoothers
191    and nonlinear preconditioners.
192 
193    Logically Collective on SNES
194 
195    Input Parameters:
196 +  snes    - the multigrid context
197 .  gsfunc  - the nonlinear smoother function
198 .  ctx     - the user context for the nonlinear smoother
199 -  use_gs  - whether to use the nonlinear smoother or not
200 
201    Level: advanced
202 
203 .keywords: FAS, MG, set, cycles, gauss-seidel, multigrid
204 
205 .seealso: SNESSetGS(), SNESFASSetGSOnLevel()
206 @*/
207 PetscErrorCode SNESFASSetGS(SNES snes, PetscErrorCode (*gsfunc)(SNES,Vec,Vec,void *), void * ctx, PetscBool use_gs) {
208   PetscErrorCode ierr = 0;
209   SNES_FAS       *fas = (SNES_FAS *)snes->data;
210   PetscFunctionBegin;
211 
212   if (gsfunc) {
213     ierr = SNESSetGS(snes, gsfunc, ctx);CHKERRQ(ierr);
214     /* push the provided GS up the tree */
215     if (fas->next) ierr = SNESFASSetGS(fas->next, gsfunc, ctx, use_gs);CHKERRQ(ierr);
216   } else if (snes->ops->computegs) {
217     /* assume that the user has set the GS solver at this level */
218     if (fas->next) ierr = SNESFASSetGS(fas->next, PETSC_NULL, PETSC_NULL, use_gs);CHKERRQ(ierr);
219   } else if (use_gs) {
220     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "No user Gauss-Seidel function provided in SNESFASSetGS on level %d", fas->level);
221   }
222   PetscFunctionReturn(0);
223 }
224 
225 #undef __FUNCT__
226 #define __FUNCT__ "SNESFASSetGSOnLevel"
227 /*@C
228    SNESFASSetGSOnLevel - Sets the nonlinear smoother on a particular level.
229 
230    Logically Collective on SNES
231 
232    Input Parameters:
233 +  snes    - the multigrid context
234 .  level   - the level to set the nonlinear smoother on
235 .  gsfunc  - the nonlinear smoother function
236 .  ctx     - the user context for the nonlinear smoother
237 -  use_gs  - whether to use the nonlinear smoother or not
238 
239    Level: advanced
240 
241 .keywords: FAS, MG, set, cycles, Gauss-Seidel, multigrid
242 
243 .seealso: SNESSetGS(), SNESFASSetGS()
244 @*/
245 PetscErrorCode SNESFASSetGSOnLevel(SNES snes, PetscInt level, PetscErrorCode (*gsfunc)(SNES,Vec,Vec,void *), void * ctx, PetscBool use_gs) {
246   SNES_FAS       *fas =  (SNES_FAS *)snes->data;
247   PetscErrorCode ierr;
248   PetscInt       top_level = fas->level,i;
249   SNES           cur_snes = snes;
250   PetscFunctionBegin;
251   if (level > top_level)
252     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetCyclesOnLevel", level);
253   /* get to the correct level */
254   for (i = fas->level; i > level; i--) {
255     fas = (SNES_FAS *)fas->next->data;
256     cur_snes = fas->next;
257   }
258   if (fas->level != level)
259     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetCyclesOnLevel");
260   if (gsfunc) {
261     ierr = SNESSetGS(cur_snes, gsfunc, ctx);CHKERRQ(ierr);
262   }
263   PetscFunctionReturn(0);
264 }
265 
266 #undef __FUNCT__
267 #define __FUNCT__ "SNESFASGetSNES"
268 /*@
269    SNESFASGetSNES - Gets the SNES corresponding to a particular
270    level of the FAS hierarchy.
271 
272    Input Parameters:
273 +  snes    - the multigrid context
274    level   - the level to get
275 -  lsnes   - whether to use the nonlinear smoother or not
276 
277    Level: advanced
278 
279 .keywords: FAS, MG, set, cycles, Gauss-Seidel, multigrid
280 
281 .seealso: SNESFASSetLevels(), SNESFASGetLevels()
282 @*/
283 PetscErrorCode SNESFASGetSNES(SNES snes, PetscInt level, SNES * lsnes) {
284   SNES_FAS * fas = (SNES_FAS *)snes->data;
285   PetscInt levels = fas->level;
286   PetscInt i;
287   PetscFunctionBegin;
288   *lsnes = snes;
289   if (fas->level < level) {
290     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "SNESFASGetSNES should only be called on a finer SNESFAS instance than the level.");
291   }
292   if (level > levels - 1) {
293     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Level %d doesn't exist in the SNESFAS.");
294   }
295   for (i = fas->level; i > level; i--) {
296     *lsnes = fas->next;
297     fas = (SNES_FAS *)(*lsnes)->data;
298   }
299   if (fas->level != level) SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "SNESFASGetSNES didn't return the right level!");
300   PetscFunctionReturn(0);
301 }
302 
303 #undef __FUNCT__
304 #define __FUNCT__ "SNESFASSetType"
305 /*@
306 SNESFASSetType - Sets the update and correction type used for FAS.
307 e
308 
309 
310 @*/
311 PetscErrorCode  SNESFASSetType(SNES snes,SNESFASType fastype)
312 {
313   SNES_FAS                   *fas = (SNES_FAS*)snes->data;
314 
315   PetscFunctionBegin;
316   PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
317   PetscValidLogicalCollectiveEnum(snes,fastype,2);
318   fas->fastype = fastype;
319   PetscFunctionReturn(0);
320 }
321 
322 
323 
324 #undef __FUNCT__
325 #define __FUNCT__ "SNESFASSetLevels"
326 /*@C
327    SNESFASSetLevels - Sets the number of levels to use with FAS.
328    Must be called before any other FAS routine.
329 
330    Input Parameters:
331 +  snes   - the snes context
332 .  levels - the number of levels
333 -  comms  - optional communicators for each level; this is to allow solving the coarser
334             problems on smaller sets of processors. Use PETSC_NULL_OBJECT for default in
335             Fortran.
336 
337    Level: intermediate
338 
339    Notes:
340      If the number of levels is one then the multigrid uses the -fas_levels prefix
341   for setting the level options rather than the -fas_coarse prefix.
342 
343 .keywords: FAS, MG, set, levels, multigrid
344 
345 .seealso: SNESFASGetLevels()
346 @*/
347 PetscErrorCode SNESFASSetLevels(SNES snes, PetscInt levels, MPI_Comm * comms) {
348   PetscErrorCode ierr;
349   PetscInt i;
350   SNES_FAS * fas = (SNES_FAS *)snes->data;
351   SNES prevsnes;
352   MPI_Comm comm;
353   PetscFunctionBegin;
354   comm = ((PetscObject)snes)->comm;
355   if (levels == fas->levels) {
356     if (!comms)
357       PetscFunctionReturn(0);
358   }
359   /* user has changed the number of levels; reset */
360   ierr = SNESReset(snes);CHKERRQ(ierr);
361   /* destroy any coarser levels if necessary */
362   if (fas->next) SNESDestroy(&fas->next);CHKERRQ(ierr);
363   fas->next = PETSC_NULL;
364   fas->previous = PETSC_NULL;
365   prevsnes = snes;
366   /* setup the finest level */
367   for (i = levels - 1; i >= 0; i--) {
368     if (comms) comm = comms[i];
369     fas->level = i;
370     fas->levels = levels;
371     fas->next = PETSC_NULL;
372     if (i > 0) {
373       ierr = SNESCreate(comm, &fas->next);CHKERRQ(ierr);
374       ierr = SNESSetOptionsPrefix(fas->next,((PetscObject)snes)->prefix);CHKERRQ(ierr);
375       ierr = SNESSetType(fas->next, SNESFAS);CHKERRQ(ierr);
376       ierr = PetscObjectIncrementTabLevel((PetscObject)fas->next, (PetscObject)snes, levels - i);CHKERRQ(ierr);
377       ((SNES_FAS *)fas->next->data)->previous = prevsnes;
378       prevsnes = fas->next;
379       fas = (SNES_FAS *)prevsnes->data;
380     }
381   }
382   PetscFunctionReturn(0);
383 }
384 
385 #undef __FUNCT__
386 #define __FUNCT__ "SNESFASSetNumberSmoothUp"
387 /*@
388    SNESFASSetNumberSmoothUp - Sets the number of post-smoothing steps to
389    use on all levels.
390 
391    Logically Collective on SNES
392 
393    Input Parameters:
394 +  snes - the multigrid context
395 -  n    - the number of smoothing steps
396 
397    Options Database Key:
398 .  -snes_fas_smoothup <n> - Sets number of pre-smoothing steps
399 
400    Level: advanced
401 
402 .keywords: FAS, MG, smooth, down, pre-smoothing, steps, multigrid
403 
404 .seealso: SNESFASSetNumberSmoothDown()
405 @*/
406 PetscErrorCode SNESFASSetNumberSmoothUp(SNES snes, PetscInt n) {
407   SNES_FAS * fas =  (SNES_FAS *)snes->data;
408   PetscErrorCode ierr = 0;
409   PetscFunctionBegin;
410   fas->max_up_it = n;
411   if (fas->next) {
412     ierr = SNESFASSetNumberSmoothUp(fas->next, n);CHKERRQ(ierr);
413   }
414   PetscFunctionReturn(0);
415 }
416 
417 #undef __FUNCT__
418 #define __FUNCT__ "SNESFASSetNumberSmoothDown"
419 /*@
420    SNESFASSetNumberSmoothDown - Sets the number of pre-smoothing steps to
421    use on all levels.
422 
423    Logically Collective on SNES
424 
425    Input Parameters:
426 +  snes - the multigrid context
427 -  n    - the number of smoothing steps
428 
429    Options Database Key:
430 .  -snes_fas_smoothdown <n> - Sets number of pre-smoothing steps
431 
432    Level: advanced
433 
434 .keywords: FAS, MG, smooth, down, pre-smoothing, steps, multigrid
435 
436 .seealso: SNESFASSetNumberSmoothUp()
437 @*/
438 PetscErrorCode SNESFASSetNumberSmoothDown(SNES snes, PetscInt n) {
439   SNES_FAS * fas =  (SNES_FAS *)snes->data;
440   PetscErrorCode ierr = 0;
441   PetscFunctionBegin;
442   fas->max_down_it = n;
443   if (fas->next) {
444     ierr = SNESFASSetNumberSmoothDown(fas->next, n);CHKERRQ(ierr);
445   }
446   PetscFunctionReturn(0);
447 }
448 
449 #undef __FUNCT__
450 #define __FUNCT__ "SNESFASSetInterpolation"
451 /*@
452    SNESFASSetInterpolation - Sets the function to be used to calculate the
453    interpolation from l-1 to the lth level
454 
455    Input Parameters:
456 +  snes      - the multigrid context
457 .  mat       - the interpolation operator
458 -  level     - the level (0 is coarsest) to supply [do not supply 0]
459 
460    Level: advanced
461 
462    Notes:
463           Usually this is the same matrix used also to set the restriction
464     for the same level.
465 
466           One can pass in the interpolation matrix or its transpose; PETSc figures
467     out from the matrix size which one it is.
468 
469 .keywords:  FAS, multigrid, set, interpolate, level
470 
471 .seealso: SNESFASSetInjection(), SNESFASSetRestriction(), SNESFASSetRscale()
472 @*/
473 PetscErrorCode SNESFASSetInterpolation(SNES snes, PetscInt level, Mat mat) {
474   SNES_FAS * fas =  (SNES_FAS *)snes->data;
475   PetscInt top_level = fas->level,i;
476 
477   PetscFunctionBegin;
478   if (level > top_level)
479     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetInterpolation", level);
480   /* get to the correct level */
481   for (i = fas->level; i > level; i--) {
482     fas = (SNES_FAS *)fas->next->data;
483   }
484   if (fas->level != level)
485     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetInterpolation");
486   fas->interpolate = mat;
487   PetscFunctionReturn(0);
488 }
489 
490 #undef __FUNCT__
491 #define __FUNCT__ "SNESFASSetRestriction"
492 /*@
493    SNESFASSetRestriction - Sets the function to be used to restrict the defect
494    from level l to l-1.
495 
496    Input Parameters:
497 +  snes  - the multigrid context
498 .  mat   - the restriction matrix
499 -  level - the level (0 is coarsest) to supply [Do not supply 0]
500 
501    Level: advanced
502 
503    Notes:
504           Usually this is the same matrix used also to set the interpolation
505     for the same level.
506 
507           One can pass in the interpolation matrix or its transpose; PETSc figures
508     out from the matrix size which one it is.
509 
510          If you do not set this, the transpose of the Mat set with SNESFASSetInterpolation()
511     is used.
512 
513 .keywords: FAS, MG, set, multigrid, restriction, level
514 
515 .seealso: SNESFASSetInterpolation(), SNESFASSetInjection()
516 @*/
517 PetscErrorCode SNESFASSetRestriction(SNES snes, PetscInt level, Mat mat) {
518   SNES_FAS * fas =  (SNES_FAS *)snes->data;
519   PetscInt top_level = fas->level,i;
520 
521   PetscFunctionBegin;
522   if (level > top_level)
523     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetRestriction", level);
524   /* get to the correct level */
525   for (i = fas->level; i > level; i--) {
526     fas = (SNES_FAS *)fas->next->data;
527   }
528   if (fas->level != level)
529     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetRestriction");
530   fas->restrct = mat;
531   PetscFunctionReturn(0);
532 }
533 
534 
535 #undef __FUNCT__
536 #define __FUNCT__ "SNESFASSetRScale"
537 /*@
538    SNESFASSetRScale - Sets the scaling factor of the restriction
539    operator from level l to l-1.
540 
541    Input Parameters:
542 +  snes   - the multigrid context
543 .  rscale - the restriction scaling
544 -  level  - the level (0 is coarsest) to supply [Do not supply 0]
545 
546    Level: advanced
547 
548    Notes:
549          This is only used in the case that the injection is not set.
550 
551 .keywords: FAS, MG, set, multigrid, restriction, level
552 
553 .seealso: SNESFASSetInjection(), SNESFASSetRestriction()
554 @*/
555 PetscErrorCode SNESFASSetRScale(SNES snes, PetscInt level, Vec rscale) {
556   SNES_FAS * fas =  (SNES_FAS *)snes->data;
557   PetscInt top_level = fas->level,i;
558 
559   PetscFunctionBegin;
560   if (level > top_level)
561     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetRestriction", level);
562   /* get to the correct level */
563   for (i = fas->level; i > level; i--) {
564     fas = (SNES_FAS *)fas->next->data;
565   }
566   if (fas->level != level)
567     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetRestriction");
568   fas->rscale = rscale;
569   PetscFunctionReturn(0);
570 }
571 
572 
573 #undef __FUNCT__
574 #define __FUNCT__ "SNESFASSetInjection"
575 /*@
576    SNESFASSetInjection - Sets the function to be used to inject the solution
577    from level l to l-1.
578 
579    Input Parameters:
580 +  snes  - the multigrid context
581 .  mat   - the restriction matrix
582 -  level - the level (0 is coarsest) to supply [Do not supply 0]
583 
584    Level: advanced
585 
586    Notes:
587          If you do not set this, the restriction and rscale is used to
588    project the solution instead.
589 
590 .keywords: FAS, MG, set, multigrid, restriction, level
591 
592 .seealso: SNESFASSetInterpolation(), SNESFASSetRestriction()
593 @*/
594 PetscErrorCode SNESFASSetInjection(SNES snes, PetscInt level, Mat mat) {
595   SNES_FAS * fas =  (SNES_FAS *)snes->data;
596   PetscInt top_level = fas->level,i;
597 
598   PetscFunctionBegin;
599   if (level > top_level)
600     SETERRQ1(((PetscObject)snes)->comm, PETSC_ERR_ARG_OUTOFRANGE, "Bad level number %d in SNESFASSetInjection", level);
601   /* get to the correct level */
602   for (i = fas->level; i > level; i--) {
603     fas = (SNES_FAS *)fas->next->data;
604   }
605   if (fas->level != level)
606     SETERRQ(((PetscObject)snes)->comm, PETSC_ERR_ARG_WRONG, "Inconsistent level labelling in SNESFASSetInjection");
607   fas->inject = mat;
608   PetscFunctionReturn(0);
609 }
610 
611 #undef __FUNCT__
612 #define __FUNCT__ "SNESReset_FAS"
613 PetscErrorCode SNESReset_FAS(SNES snes)
614 {
615   PetscErrorCode ierr = 0;
616   SNES_FAS * fas = (SNES_FAS *)snes->data;
617 
618   PetscFunctionBegin;
619   if (fas->upsmooth)     ierr = SNESDestroy(&fas->upsmooth);CHKERRQ(ierr);
620   if (fas->downsmooth)   ierr = SNESDestroy(&fas->downsmooth);CHKERRQ(ierr);
621   if (fas->inject) {
622     ierr = MatDestroy(&fas->inject);CHKERRQ(ierr);
623   }
624   if (fas->interpolate == fas->restrct) {
625     if (fas->interpolate)  ierr = MatDestroy(&fas->interpolate);CHKERRQ(ierr);
626     fas->restrct = PETSC_NULL;
627   } else {
628     if (fas->interpolate)  ierr = MatDestroy(&fas->interpolate);CHKERRQ(ierr);
629     if (fas->restrct)      ierr = MatDestroy(&fas->restrct);CHKERRQ(ierr);
630   }
631   if (fas->rscale)       ierr = VecDestroy(&fas->rscale);CHKERRQ(ierr);
632 
633   if (fas->upsmooth)   ierr = SNESReset(fas->upsmooth);CHKERRQ(ierr);
634   if (fas->downsmooth) ierr = SNESReset(fas->downsmooth);CHKERRQ(ierr);
635   if (fas->next)       ierr = SNESReset(fas->next);CHKERRQ(ierr);
636   PetscFunctionReturn(0);
637 }
638 
639 #undef __FUNCT__
640 #define __FUNCT__ "SNESDestroy_FAS"
641 PetscErrorCode SNESDestroy_FAS(SNES snes)
642 {
643   SNES_FAS * fas = (SNES_FAS *)snes->data;
644   PetscErrorCode ierr = 0;
645 
646   PetscFunctionBegin;
647   /* recursively resets and then destroys */
648   ierr = SNESReset(snes);CHKERRQ(ierr);
649   if (fas->next)         ierr = SNESDestroy(&fas->next);CHKERRQ(ierr);
650   ierr = PetscFree(fas);CHKERRQ(ierr);
651 
652   PetscFunctionReturn(0);
653 }
654 
655 #undef __FUNCT__
656 #define __FUNCT__ "SNESSetUp_FAS"
657 PetscErrorCode SNESSetUp_FAS(SNES snes)
658 {
659   SNES_FAS       *fas = (SNES_FAS *) snes->data;
660   PetscErrorCode ierr;
661   VecScatter     injscatter;
662   PetscInt       dm_levels;
663   Vec            vec_sol, vec_func, vec_sol_update, vec_rhs; /* preserve these if they're set through the reset */
664 
665   PetscFunctionBegin;
666 
667   if (fas->usedmfornumberoflevels && (fas->level == fas->levels - 1)) {
668     ierr = DMGetRefineLevel(snes->dm,&dm_levels);CHKERRQ(ierr);
669     dm_levels++;
670     if (dm_levels > fas->levels) {
671 
672       /* we don't want the solution and func vectors to be destroyed in the SNESReset when it's called in SNESSetUp_FAS*/
673       vec_sol = snes->vec_sol;
674       vec_func = snes->vec_func;
675       vec_sol_update = snes->vec_sol_update;
676       vec_rhs = snes->vec_rhs;
677       snes->vec_sol = PETSC_NULL;
678       snes->vec_func = PETSC_NULL;
679       snes->vec_sol_update = PETSC_NULL;
680       snes->vec_rhs = PETSC_NULL;
681 
682       /* reset the number of levels */
683       ierr = SNESFASSetLevels(snes,dm_levels,PETSC_NULL);CHKERRQ(ierr);
684       ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
685 
686       snes->vec_sol = vec_sol;
687       snes->vec_func = vec_func;
688       snes->vec_rhs = vec_rhs;
689       snes->vec_sol_update = vec_sol_update;
690     }
691   }
692 
693   if (fas->level != fas->levels - 1) snes->gridsequence = 0; /* no grid sequencing inside the multigrid hierarchy! */
694 
695   if (fas->fastype == SNES_FAS_MULTIPLICATIVE) {
696     ierr = SNESDefaultGetWork(snes, 4);CHKERRQ(ierr); /* work vectors used for intergrid transfers */
697   } else {
698     ierr = SNESDefaultGetWork(snes, 4);CHKERRQ(ierr); /* work vectors used for intergrid transfers */
699   }
700 
701   if (snes->dm) {
702     /* construct EVERYTHING from the DM -- including the progressive set of smoothers */
703     if (fas->next) {
704       /* for now -- assume the DM and the evaluation functions have been set externally */
705       if (!fas->next->dm) {
706         ierr = DMCoarsen(snes->dm, ((PetscObject)fas->next)->comm, &fas->next->dm);CHKERRQ(ierr);
707         ierr = SNESSetDM(fas->next, fas->next->dm);CHKERRQ(ierr);
708       }
709       /* set the interpolation and restriction from the DM */
710       if (!fas->interpolate) {
711         ierr = DMCreateInterpolation(fas->next->dm, snes->dm, &fas->interpolate, &fas->rscale);CHKERRQ(ierr);
712         fas->restrct = fas->interpolate;
713       }
714       /* set the injection from the DM */
715       if (!fas->inject) {
716         ierr = DMCreateInjection(fas->next->dm, snes->dm, &injscatter);CHKERRQ(ierr);
717         ierr = MatCreateScatter(((PetscObject)snes)->comm, injscatter, &fas->inject);CHKERRQ(ierr);
718         ierr = VecScatterDestroy(&injscatter);CHKERRQ(ierr);
719       }
720     }
721     /* set the DMs of the pre and post-smoothers here */
722     if (fas->upsmooth)  {ierr = SNESSetDM(fas->upsmooth,   snes->dm);CHKERRQ(ierr);}
723     if (fas->downsmooth){ierr = SNESSetDM(fas->downsmooth, snes->dm);CHKERRQ(ierr);}
724   }
725   /*pass the smoother, function, and jacobian up to the next level if it's not user set already */
726 
727  if (fas->next) {
728     if (fas->galerkin) {
729       ierr = SNESSetFunction(fas->next, PETSC_NULL, SNESFASGalerkinDefaultFunction, fas->next);CHKERRQ(ierr);
730     } else {
731       if (snes->ops->computefunction && !fas->next->ops->computefunction) {
732         ierr = SNESSetFunction(fas->next, PETSC_NULL, snes->ops->computefunction, snes->funP);CHKERRQ(ierr);
733       }
734       if (snes->ops->computejacobian && !fas->next->ops->computejacobian) {
735         ierr = SNESSetJacobian(fas->next, fas->next->jacobian, fas->next->jacobian_pre, snes->ops->computejacobian, snes->jacP);CHKERRQ(ierr);
736       }
737       if (snes->ops->computegs && !fas->next->ops->computegs) {
738         ierr = SNESSetGS(fas->next, snes->ops->computegs, snes->gsP);CHKERRQ(ierr);
739       }
740     }
741   }
742 
743   if (fas->next) {
744     /* gotta set up the solution vector for this to work */
745     if (!fas->next->vec_sol) {ierr = VecDuplicate(fas->rscale, &fas->next->vec_sol);CHKERRQ(ierr);}
746     if (!fas->next->vec_rhs) {ierr = VecDuplicate(fas->rscale, &fas->next->vec_rhs);CHKERRQ(ierr);}
747     ierr = SNESSetUp(fas->next);CHKERRQ(ierr);
748   }
749 
750   /* setup the pre and post smoothers and set their function, jacobian, and gs evaluation routines if the user has neglected this */
751   if (fas->upsmooth) {
752     if (snes->ops->computefunction && !fas->upsmooth->ops->computefunction) {
753       ierr = SNESSetFunction(fas->upsmooth, PETSC_NULL, snes->ops->computefunction, snes->funP);CHKERRQ(ierr);
754     }
755     if (snes->ops->computejacobian && !fas->upsmooth->ops->computejacobian) {
756       ierr = SNESSetJacobian(fas->upsmooth, fas->upsmooth->jacobian, fas->upsmooth->jacobian_pre, snes->ops->computejacobian, snes->jacP);CHKERRQ(ierr);
757     }
758    if (snes->ops->computegs && !fas->upsmooth->ops->computegs) {
759       ierr = SNESSetGS(fas->upsmooth, snes->ops->computegs, snes->gsP);CHKERRQ(ierr);
760     }
761    ierr = SNESSetFromOptions(fas->upsmooth);CHKERRQ(ierr);
762   }
763   if (fas->downsmooth) {
764     if (snes->ops->computefunction && !fas->downsmooth->ops->computefunction) {
765       ierr = SNESSetFunction(fas->downsmooth, PETSC_NULL, snes->ops->computefunction, snes->funP);CHKERRQ(ierr);
766     }
767     if (snes->ops->computejacobian && !fas->downsmooth->ops->computejacobian) {
768       ierr = SNESSetJacobian(fas->downsmooth, fas->downsmooth->jacobian, fas->downsmooth->jacobian_pre, snes->ops->computejacobian, snes->jacP);CHKERRQ(ierr);
769     }
770    if (snes->ops->computegs && !fas->downsmooth->ops->computegs) {
771      ierr = SNESSetGS(fas->downsmooth, snes->ops->computegs, snes->gsP);CHKERRQ(ierr);
772     }
773     ierr = SNESSetFromOptions(fas->downsmooth);CHKERRQ(ierr);
774   }
775 
776   /* setup FAS work vectors */
777   if (fas->galerkin) {
778     ierr = VecDuplicate(snes->vec_sol, &fas->Xg);CHKERRQ(ierr);
779     ierr = VecDuplicate(snes->vec_sol, &fas->Fg);CHKERRQ(ierr);
780   }
781 
782 
783   /* got to set them all up at once */
784   PetscFunctionReturn(0);
785 }
786 
787 #undef __FUNCT__
788 #define __FUNCT__ "SNESSetFromOptions_FAS"
789 PetscErrorCode SNESSetFromOptions_FAS(SNES snes)
790 {
791   SNES_FAS       *fas = (SNES_FAS *) snes->data;
792   PetscInt       levels = 1;
793   PetscBool      flg, smoothflg, smoothupflg, smoothdownflg, smoothcoarseflg = PETSC_FALSE, monflg;
794   PetscErrorCode ierr;
795   char           monfilename[PETSC_MAX_PATH_LEN];
796   SNESFASType    fastype;
797   const char     *optionsprefix;
798   const char     *prefix;
799 
800   PetscFunctionBegin;
801   ierr = PetscOptionsHead("SNESFAS Options-----------------------------------");CHKERRQ(ierr);
802 
803   /* number of levels -- only process on the finest level */
804   if (fas->levels - 1 == fas->level) {
805     ierr = PetscOptionsInt("-snes_fas_levels", "Number of Levels", "SNESFASSetLevels", levels, &levels, &flg);CHKERRQ(ierr);
806     if (!flg && snes->dm) {
807       ierr = DMGetRefineLevel(snes->dm,&levels);CHKERRQ(ierr);
808       levels++;
809       fas->usedmfornumberoflevels = PETSC_TRUE;
810     }
811     ierr = SNESFASSetLevels(snes, levels, PETSC_NULL);CHKERRQ(ierr);
812   }
813   fastype = fas->fastype;
814   ierr = PetscOptionsEnum("-snes_fas_type","FAS correction type","SNESFASSetType",SNESFASTypes,(PetscEnum)fastype,(PetscEnum*)&fastype,&flg);CHKERRQ(ierr);
815   if (flg) {
816     ierr = SNESFASSetType(snes, fastype);CHKERRQ(ierr);
817   }
818 
819   ierr = SNESGetOptionsPrefix(snes, &optionsprefix);CHKERRQ(ierr);
820 
821   /* smoother setup options */
822   ierr = PetscOptionsHasName(optionsprefix, "-fas_snes_type", &smoothflg);CHKERRQ(ierr);
823   ierr = PetscOptionsHasName(optionsprefix, "-fas_up_snes_type", &smoothupflg);CHKERRQ(ierr);
824   ierr = PetscOptionsHasName(optionsprefix, "-fas_down_snes_type", &smoothdownflg);CHKERRQ(ierr);
825   if (fas->level == 0) {
826     ierr = PetscOptionsHasName(optionsprefix, "-fas_coarse_snes_type", &smoothcoarseflg);CHKERRQ(ierr);
827   }
828   /* options for the number of preconditioning cycles and cycle type */
829 
830   ierr = PetscOptionsInt("-snes_fas_cycles","Number of cycles","SNESFASSetCycles",fas->n_cycles,&fas->n_cycles,&flg);CHKERRQ(ierr);
831 
832   ierr = PetscOptionsBool("-snes_fas_galerkin", "Form coarse problems with Galerkin","SNESFAS",fas->galerkin,&fas->galerkin,&flg);CHKERRQ(ierr);
833 
834   ierr = PetscOptionsString("-snes_fas_monitor","Monitor FAS progress","SNESMonitorSet","stdout",monfilename,PETSC_MAX_PATH_LEN,&monflg);CHKERRQ(ierr);
835 
836 
837   ierr = PetscOptionsTail();CHKERRQ(ierr);
838   /* setup from the determined types if there is no pointwise procedure or smoother defined */
839 
840   if ((!fas->downsmooth) && smoothcoarseflg) {
841     ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
842     ierr = SNESCreate(((PetscObject)snes)->comm, &fas->downsmooth);CHKERRQ(ierr);
843     ierr = SNESSetOptionsPrefix(fas->downsmooth,prefix);CHKERRQ(ierr);
844     ierr = SNESAppendOptionsPrefix(fas->downsmooth,"fas_coarse_");CHKERRQ(ierr);
845     ierr = PetscObjectIncrementTabLevel((PetscObject)fas->downsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
846   }
847 
848   if ((!fas->downsmooth) && smoothdownflg) {
849     ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
850     ierr = SNESCreate(((PetscObject)snes)->comm, &fas->downsmooth);CHKERRQ(ierr);
851     ierr = SNESSetOptionsPrefix(fas->downsmooth,prefix);CHKERRQ(ierr);
852     ierr = SNESAppendOptionsPrefix(fas->downsmooth,"fas_down_");CHKERRQ(ierr);
853     ierr = PetscObjectIncrementTabLevel((PetscObject)fas->downsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
854   }
855 
856   if ((!fas->upsmooth) && (fas->level != 0) && smoothupflg) {
857     ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
858     ierr = SNESCreate(((PetscObject)snes)->comm, &fas->upsmooth);CHKERRQ(ierr);
859     ierr = SNESSetOptionsPrefix(fas->upsmooth,prefix);CHKERRQ(ierr);
860     ierr = SNESAppendOptionsPrefix(fas->upsmooth,"fas_up_");CHKERRQ(ierr);
861     ierr = PetscObjectIncrementTabLevel((PetscObject)fas->upsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
862   }
863 
864   if ((!fas->downsmooth) && smoothflg) {
865     ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
866     ierr = SNESCreate(((PetscObject)snes)->comm, &fas->downsmooth);CHKERRQ(ierr);
867     ierr = SNESSetOptionsPrefix(fas->downsmooth,prefix);CHKERRQ(ierr);
868     ierr = SNESAppendOptionsPrefix(fas->downsmooth,"fas_");CHKERRQ(ierr);
869     ierr = PetscObjectIncrementTabLevel((PetscObject)fas->downsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
870   }
871 
872   if ((!fas->upsmooth) && (fas->level != 0) && smoothflg) {
873     ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
874     ierr = SNESCreate(((PetscObject)snes)->comm, &fas->upsmooth);CHKERRQ(ierr);
875     ierr = SNESSetOptionsPrefix(fas->upsmooth,prefix);CHKERRQ(ierr);
876     ierr = SNESAppendOptionsPrefix(fas->upsmooth,"fas_");CHKERRQ(ierr);
877     ierr = PetscObjectIncrementTabLevel((PetscObject)fas->upsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
878   }
879 
880   if (fas->upsmooth) {
881     ierr = SNESSetTolerances(fas->upsmooth, fas->upsmooth->abstol, fas->upsmooth->rtol, fas->upsmooth->xtol, 1, 1000);CHKERRQ(ierr);
882   }
883 
884   if (fas->downsmooth) {
885     ierr = SNESSetTolerances(fas->downsmooth, fas->downsmooth->abstol, fas->downsmooth->rtol, fas->downsmooth->xtol, 1, 1000);CHKERRQ(ierr);
886   }
887 
888   if (fas->level != fas->levels - 1) {
889     ierr = SNESSetTolerances(snes, snes->abstol, snes->rtol, snes->xtol, fas->n_cycles, 1000);CHKERRQ(ierr);
890   }
891 
892   /* control the simple Richardson smoother that is default if there's no upsmooth or downsmooth */
893   if (!fas->downsmooth) {
894     ierr = PetscOptionsInt("-fas_down_snes_max_it","Down smooth iterations","SNESFASSetCycles",fas->max_down_it,&fas->max_down_it,&flg);CHKERRQ(ierr);
895     if (fas->level == 0) {
896       ierr = PetscOptionsInt("-fas_coarse_snes_max_it","Coarse smooth iterations","SNESFASSetCycles",fas->max_down_it,&fas->max_down_it,&flg);CHKERRQ(ierr);
897     }
898   }
899 
900   if (!fas->upsmooth) {
901     ierr = PetscOptionsInt("-fas_up_snes_max_it","Upsmooth iterations","SNESFASSetCycles",fas->max_up_it,&fas->max_up_it,&flg);CHKERRQ(ierr);
902   }
903 
904   if (monflg) {
905     fas->monitor = PETSC_VIEWER_STDOUT_(((PetscObject)snes)->comm);CHKERRQ(ierr);
906     /* set the monitors for the upsmoother and downsmoother */
907     ierr = SNESMonitorCancel(snes);CHKERRQ(ierr);
908     ierr = SNESMonitorSet(snes,SNESMonitorDefault,PETSC_NULL,(PetscErrorCode (*)(void**))PetscViewerDestroy);CHKERRQ(ierr);
909     if (fas->upsmooth)   ierr = SNESMonitorSet(fas->upsmooth,SNESMonitorDefault,PETSC_NULL,(PetscErrorCode (*)(void**))PetscViewerDestroy);CHKERRQ(ierr);
910     if (fas->downsmooth) ierr = SNESMonitorSet(fas->downsmooth,SNESMonitorDefault,PETSC_NULL,(PetscErrorCode (*)(void**))PetscViewerDestroy);CHKERRQ(ierr);
911   } else {
912     /* unset the monitors on the coarse levels */
913     if (fas->level != fas->levels - 1) {
914       ierr = SNESMonitorCancel(snes);CHKERRQ(ierr);
915     }
916   }
917 
918   /* recursive option setting for the smoothers */
919   if (fas->next) {ierr = SNESSetFromOptions(fas->next);CHKERRQ(ierr);}
920   PetscFunctionReturn(0);
921 }
922 
923 #undef __FUNCT__
924 #define __FUNCT__ "SNESView_FAS"
925 PetscErrorCode SNESView_FAS(SNES snes, PetscViewer viewer)
926 {
927   SNES_FAS   *fas = (SNES_FAS *) snes->data;
928   PetscBool      iascii;
929   PetscErrorCode ierr;
930 
931   PetscFunctionBegin;
932   ierr = PetscTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
933   if (iascii) {
934     ierr = PetscViewerASCIIPrintf(viewer, "FAS, levels = %d\n",  fas->levels);CHKERRQ(ierr);
935     ierr = PetscViewerASCIIPushTab(viewer);
936     ierr = PetscViewerASCIIPrintf(viewer, "level: %d\n",  fas->level);CHKERRQ(ierr);
937     if (fas->upsmooth) {
938       ierr = PetscViewerASCIIPrintf(viewer, "up-smoother on level %D:\n",  fas->level);CHKERRQ(ierr);
939       ierr = PetscViewerASCIIPushTab(viewer);
940       ierr = SNESView(fas->upsmooth, viewer);CHKERRQ(ierr);
941       ierr = PetscViewerASCIIPopTab(viewer);
942     } else {
943       ierr = PetscViewerASCIIPrintf(viewer, "no up-smoother on level %D\n",  fas->level);CHKERRQ(ierr);
944     }
945     if (fas->downsmooth) {
946       ierr = PetscViewerASCIIPrintf(viewer, "down-smoother on level %D:\n",  fas->level);CHKERRQ(ierr);
947       ierr = PetscViewerASCIIPushTab(viewer);
948       ierr = SNESView(fas->downsmooth, viewer);CHKERRQ(ierr);
949       ierr = PetscViewerASCIIPopTab(viewer);
950     } else {
951       ierr = PetscViewerASCIIPrintf(viewer, "no down-smoother on level %D\n",  fas->level);CHKERRQ(ierr);
952     }
953     ierr = PetscViewerASCIIPopTab(viewer);
954   } else {
955     SETERRQ1(((PetscObject)snes)->comm,PETSC_ERR_SUP,"Viewer type %s not supported for SNESFAS",((PetscObject)viewer)->type_name);
956   }
957   PetscFunctionReturn(0);
958 }
959 
960 #undef __FUNCT__
961 #define __FUNCT__ "FASDownSmooth"
962 /*
963 Defines the action of the downsmoother
964  */
965 PetscErrorCode FASDownSmooth(SNES snes, Vec B, Vec X, Vec F){
966   PetscErrorCode      ierr = 0;
967   PetscReal           fnorm, gnorm, ynorm, xnorm = 0.0;
968   SNESConvergedReason reason;
969   SNES_FAS            *fas = (SNES_FAS *)snes->data;
970   Vec                 G, W, Y;
971   PetscBool           lssuccess;
972   PetscInt            k;
973   PetscFunctionBegin;
974   G = snes->work[1];
975   W = snes->work[2];
976   Y = snes->work[3];
977   if (fas->downsmooth) {
978     ierr = SNESSolve(fas->downsmooth, B, X);CHKERRQ(ierr);
979     /* check convergence reason for the smoother */
980     ierr = SNESGetConvergedReason(fas->downsmooth,&reason);CHKERRQ(ierr);
981     if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
982       snes->reason = SNES_DIVERGED_INNER;
983       PetscFunctionReturn(0);
984     }
985   } else {
986     /* basic richardson smoother */
987     for (k = 0; k < fas->max_up_it; k++) {
988       ierr = SNESComputeFunction(snes, X, F);CHKERRQ(ierr);
989       ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr);
990       ierr = VecCopy(F, Y);CHKERRQ(ierr);
991       ierr = (*snes->ops->linesearch)(snes,snes->lsP,X,F,Y,fnorm,xnorm,G,W,&ynorm,&gnorm,&lssuccess);CHKERRQ(ierr);
992       if (!lssuccess) {
993         if (++snes->numFailures >= snes->maxFailures) {
994           snes->reason = SNES_DIVERGED_LINE_SEARCH;
995           PetscFunctionReturn(0);
996         }
997       }
998       ierr = VecCopy(W, X);CHKERRQ(ierr);
999       ierr = VecCopy(G, F);CHKERRQ(ierr);
1000       fnorm = gnorm;
1001     }
1002   }
1003   PetscFunctionReturn(0);
1004 }
1005 
1006 
1007 #undef __FUNCT__
1008 #define __FUNCT__ "FASUpSmooth"
1009 /*
1010 Defines the action of the upsmoother
1011  */
1012 PetscErrorCode FASUpSmooth (SNES snes, Vec B, Vec X, Vec F) {
1013   PetscErrorCode      ierr = 0;
1014   PetscReal           fnorm, gnorm, ynorm, xnorm = 0.0;
1015   SNESConvergedReason reason;
1016   SNES_FAS            *fas = (SNES_FAS *)snes->data;
1017   Vec                 G, W, Y;
1018   PetscBool           lssuccess;
1019   PetscInt            k;
1020   PetscFunctionBegin;
1021   G = snes->work[1];
1022   W = snes->work[2];
1023   Y = snes->work[3];
1024   if (fas->upsmooth) {
1025     ierr = SNESSolve(fas->upsmooth, B, X);CHKERRQ(ierr);
1026     /* check convergence reason for the smoother */
1027     ierr = SNESGetConvergedReason(fas->upsmooth,&reason);CHKERRQ(ierr);
1028     if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
1029       snes->reason = SNES_DIVERGED_INNER;
1030       PetscFunctionReturn(0);
1031     }
1032   } else {
1033     /* basic richardson smoother */
1034     for (k = 0; k < fas->max_up_it; k++) {
1035       ierr = SNESComputeFunction(snes, X, F);CHKERRQ(ierr);
1036       ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr);
1037       ierr = VecCopy(F, Y);CHKERRQ(ierr);
1038       ierr = (*snes->ops->linesearch)(snes,snes->lsP,X,F,Y,fnorm,xnorm,G,W,&ynorm,&gnorm,&lssuccess);CHKERRQ(ierr);
1039       if (!lssuccess) {
1040         if (++snes->numFailures >= snes->maxFailures) {
1041           snes->reason = SNES_DIVERGED_LINE_SEARCH;
1042           PetscFunctionReturn(0);
1043         }
1044       }
1045       ierr = VecCopy(W, X);CHKERRQ(ierr);
1046       ierr = VecCopy(G, F);CHKERRQ(ierr);
1047       fnorm = gnorm;
1048     }
1049   }
1050   PetscFunctionReturn(0);
1051 }
1052 
1053 #undef __FUNCT__
1054 #define __FUNCT__ "FASCoarseCorrection"
1055 /*
1056 
1057 Performs the FAS coarse correction as:
1058 
1059 fine problem: F(x) = 0
1060 coarse problem: F^c(x) = b^c
1061 
1062 b^c = F^c(I^c_fx^f - I^c_fF(x))
1063 
1064 with correction:
1065 
1066 
1067 
1068  */
1069 PetscErrorCode FASCoarseCorrection(SNES snes, Vec X, Vec F, Vec X_new) {
1070   PetscErrorCode      ierr;
1071   Vec                 X_c, Xo_c, F_c, B_c;
1072   SNES_FAS            *fas = (SNES_FAS *)snes->data;
1073   SNESConvergedReason reason;
1074   PetscFunctionBegin;
1075   if (fas->next) {
1076     ierr = SNESComputeFunction(snes, X, F);CHKERRQ(ierr);
1077 
1078     X_c  = fas->next->vec_sol;
1079     Xo_c = fas->next->work[0];
1080     F_c  = fas->next->vec_func;
1081     B_c  = fas->next->vec_rhs;
1082 
1083     /* inject the solution */
1084     if (fas->inject) {
1085       ierr = MatRestrict(fas->inject, X, Xo_c);CHKERRQ(ierr);
1086     } else {
1087       ierr = MatRestrict(fas->restrct, X, Xo_c);CHKERRQ(ierr);
1088       ierr = VecPointwiseMult(Xo_c, fas->rscale, Xo_c);CHKERRQ(ierr);
1089     }
1090     ierr = VecScale(F, -1.0);CHKERRQ(ierr);
1091 
1092     /* restrict the defect */
1093     ierr = MatRestrict(fas->restrct, F, B_c);CHKERRQ(ierr);
1094 
1095     /* solve the coarse problem corresponding to F^c(x^c) = b^c = Rb + F^c(Rx) - RF(x) */
1096     fas->next->vec_rhs = PETSC_NULL;                                           /*unset the RHS to evaluate function instead of residual*/
1097     ierr = SNESComputeFunction(fas->next, Xo_c, F_c);CHKERRQ(ierr);
1098 
1099     ierr = VecAXPY(B_c, 1.0, F_c);CHKERRQ(ierr);                               /* add F_c(X) to the RHS */
1100 
1101     /* set initial guess of the coarse problem to the projected fine solution */
1102     ierr = VecCopy(Xo_c, X_c);CHKERRQ(ierr);
1103 
1104     /* recurse to the next level */
1105     fas->next->vec_rhs = B_c;
1106     /* ierr = FASCycle_Private(fas->next, X_c);CHKERRQ(ierr); */
1107     ierr = SNESSolve(fas->next, B_c, X_c);CHKERRQ(ierr);
1108     ierr = SNESGetConvergedReason(fas->next,&reason);CHKERRQ(ierr);
1109     if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
1110       snes->reason = SNES_DIVERGED_INNER;
1111       PetscFunctionReturn(0);
1112     }
1113     /* fas->next->vec_rhs = PETSC_NULL; */
1114 
1115     /* correct as x <- x + I(x^c - Rx)*/
1116     ierr = VecAXPY(X_c, -1.0, Xo_c);CHKERRQ(ierr);
1117     ierr = MatInterpolateAdd(fas->interpolate, X_c, X, X_new);CHKERRQ(ierr);
1118   }
1119   PetscFunctionReturn(0);
1120 }
1121 
1122 #undef __FUNCT__
1123 #define __FUNCT__ "FASCycle_Additive"
1124 /*
1125 
1126 The additive cycle looks like:
1127 
1128 xhat = x
1129 xhat = dS(x, b)
1130 x = coarsecorrection(xhat, b_d)
1131 x = x + nu*(xhat - x);
1132 (optional) x = uS(x, b)
1133 
1134 With the coarse RHS (defect correction) as below.
1135 
1136  */
1137 PetscErrorCode FASCycle_Additive(SNES snes, Vec X) {
1138   Vec                 F, B, Xhat;
1139   Vec                 X_c, Xo_c, F_c, B_c, G, W;
1140   PetscErrorCode      ierr;
1141   SNES_FAS *          fas = (SNES_FAS *)snes->data;
1142   SNESConvergedReason reason;
1143   PetscReal           xnorm = 0., fnorm = 0., gnorm = 0., ynorm = 0.;
1144   PetscBool           lssucceed;
1145   PetscFunctionBegin;
1146 
1147   F = snes->vec_func;
1148   B = snes->vec_rhs;
1149   Xhat = snes->work[3];
1150   G    = snes->work[1];
1151   W    = snes->work[2];
1152   ierr = VecCopy(X, Xhat);CHKERRQ(ierr);
1153   /* recurse first */
1154   if (fas->next) {
1155     ierr = SNESComputeFunction(snes, Xhat, F);CHKERRQ(ierr);
1156 
1157     X_c  = fas->next->vec_sol;
1158     Xo_c = fas->next->work[0];
1159     F_c  = fas->next->vec_func;
1160     B_c  = fas->next->vec_rhs;
1161 
1162     /* inject the solution */
1163     if (fas->inject) {
1164       ierr = MatRestrict(fas->inject, Xhat, Xo_c);CHKERRQ(ierr);
1165     } else {
1166       ierr = MatRestrict(fas->restrct, Xhat, Xo_c);CHKERRQ(ierr);
1167       ierr = VecPointwiseMult(Xo_c, fas->rscale, Xo_c);CHKERRQ(ierr);
1168     }
1169     ierr = VecScale(F, -1.0);CHKERRQ(ierr);
1170 
1171     /* restrict the defect */
1172     ierr = MatRestrict(fas->restrct, F, B_c);CHKERRQ(ierr);
1173 
1174     /* solve the coarse problem corresponding to F^c(x^c) = b^c = Rb + F^c(Rx) - RF(x) */
1175     fas->next->vec_rhs = PETSC_NULL;                                           /*unset the RHS to evaluate function instead of residual*/
1176     ierr = SNESComputeFunction(fas->next, Xo_c, F_c);CHKERRQ(ierr);
1177 
1178     ierr = VecAXPY(B_c, 1.0, F_c);CHKERRQ(ierr);                               /* add F_c(X) to the RHS */
1179 
1180     /* set initial guess of the coarse problem to the projected fine solution */
1181     ierr = VecCopy(Xo_c, X_c);CHKERRQ(ierr);
1182 
1183     /* recurse */
1184     fas->next->vec_rhs = B_c;
1185     ierr = SNESSolve(fas->next, B_c, X_c);CHKERRQ(ierr);
1186 
1187     /* smooth on this level */
1188     ierr = FASDownSmooth(snes, B, X, F);CHKERRQ(ierr);
1189 
1190    ierr = SNESGetConvergedReason(fas->next,&reason);CHKERRQ(ierr);
1191     if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
1192       snes->reason = SNES_DIVERGED_INNER;
1193       PetscFunctionReturn(0);
1194     }
1195 
1196     /* correct as x <- x + I(x^c - Rx)*/
1197     ierr = VecAXPY(X_c, -1.0, Xo_c);CHKERRQ(ierr);
1198     ierr = MatInterpolate(fas->interpolate, X_c, Xhat);CHKERRQ(ierr);
1199 
1200     /* additive correction of the coarse direction*/
1201     ierr = SNESComputeFunction(snes, X, F);CHKERRQ(ierr);
1202     ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr);
1203     ierr = VecScale(Xhat, -1.0);CHKERRQ(ierr);
1204     ierr = (*snes->ops->linesearch)(snes,snes->lsP,X,F,Xhat,fnorm,xnorm,G,W,&ynorm,&gnorm,&lssucceed);CHKERRQ(ierr);
1205     ierr = VecCopy(W, X);CHKERRQ(ierr);
1206     ierr = VecCopy(G, F);CHKERRQ(ierr);
1207     fnorm = gnorm;
1208   } else {
1209     ierr = FASDownSmooth(snes, B, X, F);CHKERRQ(ierr);
1210   }
1211   PetscFunctionReturn(0);
1212 }
1213 
1214 #undef __FUNCT__
1215 #define __FUNCT__ "FASCycle_Multiplicative"
1216 /*
1217 
1218 Defines the FAS cycle as:
1219 
1220 fine problem: F(x) = 0
1221 coarse problem: F^c(x) = b^c
1222 
1223 b^c = F^c(I^c_fx^f - I^c_fF(x))
1224 
1225 correction:
1226 
1227 x = x + I(x^c - Rx)
1228 
1229  */
1230 PetscErrorCode FASCycle_Multiplicative(SNES snes, Vec X) {
1231 
1232   PetscErrorCode      ierr;
1233   Vec                 F,B;
1234   SNES_FAS            *fas = (SNES_FAS *)snes->data;
1235 
1236   PetscFunctionBegin;
1237   F = snes->vec_func;
1238   B = snes->vec_rhs;
1239   /* pre-smooth -- just update using the pre-smoother */
1240   ierr = FASDownSmooth(snes, B, X, F);CHKERRQ(ierr);
1241 
1242   ierr = FASCoarseCorrection(snes, X, F, X);CHKERRQ(ierr);
1243 
1244   if (fas->level != 0) {
1245     ierr = FASUpSmooth(snes, B, X, F);CHKERRQ(ierr);
1246   }
1247   ierr = SNESComputeFunction(snes, X, F);CHKERRQ(ierr);
1248 
1249   PetscFunctionReturn(0);
1250 }
1251 
1252 #undef __FUNCT__
1253 #define __FUNCT__ "SNESSolve_FAS"
1254 
1255 PetscErrorCode SNESSolve_FAS(SNES snes)
1256 {
1257   PetscErrorCode ierr;
1258   PetscInt       i, maxits;
1259   Vec            X, F;
1260   PetscReal      fnorm;
1261   SNES_FAS       *fas = (SNES_FAS *)snes->data;
1262   PetscFunctionBegin;
1263   maxits = snes->max_its;            /* maximum number of iterations */
1264   snes->reason = SNES_CONVERGED_ITERATING;
1265   X = snes->vec_sol;
1266   F = snes->vec_func;
1267 
1268   /*norm setup */
1269   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1270   snes->iter = 0;
1271   snes->norm = 0.;
1272   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1273   ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
1274   if (snes->domainerror) {
1275     snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
1276     PetscFunctionReturn(0);
1277   }
1278   ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr); /* fnorm <- ||F||  */
1279   if (PetscIsInfOrNanReal(fnorm)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FP,"Infinite or not-a-number generated in norm");
1280   ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1281   snes->norm = fnorm;
1282   ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1283   SNESLogConvHistory(snes,fnorm,0);
1284   ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
1285 
1286   /* set parameter for default relative tolerance convergence test */
1287   snes->ttol = fnorm*snes->rtol;
1288   /* test convergence */
1289   ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
1290   if (snes->reason) PetscFunctionReturn(0);
1291   for (i = 0; i < maxits; i++) {
1292     /* Call general purpose update function */
1293 
1294     if (snes->ops->update) {
1295       ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
1296     }
1297     if (fas->fastype == SNES_FAS_MULTIPLICATIVE) {
1298       ierr = FASCycle_Multiplicative(snes, X);CHKERRQ(ierr);
1299     } else {
1300       ierr = FASCycle_Additive(snes, X);CHKERRQ(ierr);
1301     }
1302 
1303     /* check for FAS cycle divergence */
1304     if (snes->reason != SNES_CONVERGED_ITERATING) {
1305       PetscFunctionReturn(0);
1306     }
1307     ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr); /* fnorm <- ||F||  */
1308     /* Monitor convergence */
1309     ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
1310     snes->iter = i+1;
1311     snes->norm = fnorm;
1312     ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
1313     SNESLogConvHistory(snes,snes->norm,0);
1314     ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
1315     /* Test for convergence */
1316     ierr = (*snes->ops->converged)(snes,snes->iter,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
1317     if (snes->reason) break;
1318   }
1319   if (i == maxits) {
1320     ierr = PetscInfo1(snes, "Maximum number of iterations has been reached: %D\n", maxits);CHKERRQ(ierr);
1321     if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
1322   }
1323   PetscFunctionReturn(0);
1324 }
1325