xref: /petsc/src/snes/mf/snesmfj.c (revision 7bd18339000a996b4d2a36f55f5bcb5e6ccfe1dd)
1 /*$Id: snesmfj.c,v 1.122 2001/05/29 03:40:33 bsmith Exp bsmith $*/
2 
3 #include "src/snes/snesimpl.h"
4 #include "src/snes/mf/snesmfj.h"   /*I  "petscsnes.h"   I*/
5 
6 PetscFList      MatSNESMPetscFList              = 0;
7 PetscTruth MatSNESMFRegisterAllCalled = PETSC_FALSE;
8 
9 #undef __FUNCT__
10 #define __FUNCT__ "MatSNESMFSetType"
11 /*@C
12     MatSNESMFSetType - Sets the method that is used to compute the
13     differencing parameter for finite differene matrix-free formulations.
14 
15     Input Parameters:
16 +   mat - the "matrix-free" matrix created via MatCreateSNESMF()
17 -   ftype - the type requested
18 
19     Level: advanced
20 
21     Notes:
22     For example, such routines can compute h for use in
23     Jacobian-vector products of the form
24 
25                         F(x+ha) - F(x)
26           F'(u)a  ~=  ----------------
27                               h
28 
29 .seealso: MatCreateSNESMF(), MatSNESMFRegisterDynamic)
30 @*/
31 int MatSNESMFSetType(Mat mat,MatSNESMFType ftype)
32 {
33   int          ierr,(*r)(MatSNESMFCtx);
34   MatSNESMFCtx ctx;
35   PetscTruth   match;
36 
37   PetscFunctionBegin;
38   PetscValidHeaderSpecific(mat,MAT_COOKIE);
39   PetscValidCharPointer(ftype);
40 
41   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
42 
43   /* already set, so just return */
44   ierr = PetscTypeCompare((PetscObject)ctx,ftype,&match);CHKERRQ(ierr);
45   if (match) PetscFunctionReturn(0);
46 
47   /* destroy the old one if it exists */
48   if (ctx->ops->destroy) {
49     ierr = (*ctx->ops->destroy)(ctx);CHKERRQ(ierr);
50   }
51 
52   /* Get the function pointers for the requrested method */
53   if (!MatSNESMFRegisterAllCalled) {ierr = MatSNESMFRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
54 
55   ierr =  PetscFListFind(ctx->comm,MatSNESMPetscFList,ftype,(void (**)(void)) &r);CHKERRQ(ierr);
56 
57   if (!r) SETERRQ(1,"Unknown MatSNESMF type given");
58 
59   ierr = (*r)(ctx);CHKERRQ(ierr);
60 
61   ierr = PetscObjectChangeTypeName((PetscObject)ctx,ftype);CHKERRQ(ierr);
62 
63   PetscFunctionReturn(0);
64 }
65 
66 /*MC
67    MatSNESMFRegisterDynamic - Adds a method to the MatSNESMF registry.
68 
69    Synopsis:
70    int MatSNESMFRegisterDynamic(char *name_solver,char *path,char *name_create,int (*routine_create)(MatSNESMF))
71 
72    Not Collective
73 
74    Input Parameters:
75 +  name_solver - name of a new user-defined compute-h module
76 .  path - path (either absolute or relative) the library containing this solver
77 .  name_create - name of routine to create method context
78 -  routine_create - routine to create method context
79 
80    Level: developer
81 
82    Notes:
83    MatSNESMFRegisterDynamic) may be called multiple times to add several user-defined solvers.
84 
85    If dynamic libraries are used, then the fourth input argument (routine_create)
86    is ignored.
87 
88    Sample usage:
89 .vb
90    MatSNESMFRegisterDynamic"my_h",/home/username/my_lib/lib/libO/solaris/mylib.a,
91                "MyHCreate",MyHCreate);
92 .ve
93 
94    Then, your solver can be chosen with the procedural interface via
95 $     MatSNESMFSetType(mfctx,"my_h")
96    or at runtime via the option
97 $     -snes_mf_type my_h
98 
99 .keywords: MatSNESMF, register
100 
101 .seealso: MatSNESMFRegisterAll(), MatSNESMFRegisterDestroy()
102 M*/
103 
104 #undef __FUNCT__
105 #define __FUNCT__ "MatSNESMFRegister"
106 int MatSNESMFRegister(char *sname,char *path,char *name,int (*function)(MatSNESMFCtx))
107 {
108   int ierr;
109   char fullname[256];
110 
111   PetscFunctionBegin;
112   ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
113   ierr = PetscFListAdd(&MatSNESMPetscFList,sname,fullname,(void (*)())function);CHKERRQ(ierr);
114   PetscFunctionReturn(0);
115 }
116 
117 
118 #undef __FUNCT__
119 #define __FUNCT__ "MatSNESMFRegisterDestroy"
120 /*@C
121    MatSNESMFRegisterDestroy - Frees the list of MatSNESMF methods that were
122    registered by MatSNESMFRegisterDynamic).
123 
124    Not Collective
125 
126    Level: developer
127 
128 .keywords: MatSNESMF, register, destroy
129 
130 .seealso: MatSNESMFRegisterDynamic), MatSNESMFRegisterAll()
131 @*/
132 int MatSNESMFRegisterDestroy(void)
133 {
134   int ierr;
135 
136   PetscFunctionBegin;
137   if (MatSNESMPetscFList) {
138     ierr = PetscFListDestroy(&MatSNESMPetscFList);CHKERRQ(ierr);
139     MatSNESMPetscFList = 0;
140   }
141   MatSNESMFRegisterAllCalled = PETSC_FALSE;
142   PetscFunctionReturn(0);
143 }
144 
145 /* ----------------------------------------------------------------------------------------*/
146 #undef __FUNCT__
147 #define __FUNCT__ "MatSNESMFDestroy_Private"
148 int MatSNESMFDestroy_Private(Mat mat)
149 {
150   int          ierr;
151   MatSNESMFCtx ctx;
152 
153   PetscFunctionBegin;
154   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
155   ierr = VecDestroy(ctx->w);CHKERRQ(ierr);
156   if (ctx->ops->destroy) {ierr = (*ctx->ops->destroy)(ctx);CHKERRQ(ierr);}
157   if (ctx->sp) {ierr = MatNullSpaceDestroy(ctx->sp);CHKERRQ(ierr);}
158   PetscHeaderDestroy(ctx);
159   PetscFunctionReturn(0);
160 }
161 
162 #undef __FUNCT__
163 #define __FUNCT__ "MatSNESMFView_Private"
164 /*
165    MatSNESMFView_Private - Views matrix-free parameters.
166 
167 */
168 int MatSNESMFView_Private(Mat J,PetscViewer viewer)
169 {
170   int          ierr;
171   MatSNESMFCtx ctx;
172   PetscTruth   isascii;
173 
174   PetscFunctionBegin;
175   ierr = MatShellGetContext(J,(void **)&ctx);CHKERRQ(ierr);
176   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
177   if (isascii) {
178      ierr = PetscViewerASCIIPrintf(viewer,"  SNES matrix-free approximation:\n");CHKERRQ(ierr);
179      ierr = PetscViewerASCIIPrintf(viewer,"    err=%g (relative error in function evaluation)\n",ctx->error_rel);CHKERRQ(ierr);
180      if (!ctx->type_name) {
181        ierr = PetscViewerASCIIPrintf(viewer,"    The compute h routine has not yet been set\n");CHKERRQ(ierr);
182      } else {
183        ierr = PetscViewerASCIIPrintf(viewer,"    Using %s compute h routine\n",ctx->type_name);CHKERRQ(ierr);
184      }
185      if (ctx->ops->view) {
186        ierr = (*ctx->ops->view)(ctx,viewer);CHKERRQ(ierr);
187      }
188   } else {
189     SETERRQ1(1,"Viewer type %s not supported for SNES matrix free matrix",((PetscObject)viewer)->type_name);
190   }
191   PetscFunctionReturn(0);
192 }
193 
194 #undef __FUNCT__
195 #define __FUNCT__ "MatSNESMFAssemblyEnd_Private"
196 /*
197    MatSNESMFAssemblyEnd_Private - Resets the ctx->ncurrenth to zero. This
198    allows the user to indicate the beginning of a new linear solve by calling
199    MatAssemblyXXX() on the matrix free matrix. This then allows the
200    MatSNESMFCreate_WP() to properly compute ||U|| only the first time
201    in the linear solver rather than every time.
202 */
203 int MatSNESMFAssemblyEnd_Private(Mat J)
204 {
205   int          ierr;
206   MatSNESMFCtx j;
207 
208   PetscFunctionBegin;
209   ierr = MatSNESMFResetHHistory(J);CHKERRQ(ierr);
210   ierr = MatShellGetContext(J,(void **)&j);CHKERRQ(ierr);
211   if (j->usesnes) {
212     ierr = SNESGetSolution(j->snes,&j->current_u);CHKERRQ(ierr);
213     if (j->snes->method_class == SNES_NONLINEAR_EQUATIONS) {
214       ierr = SNESGetFunction(j->snes,&j->current_f,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
215     } else if (j->snes->method_class == SNES_UNCONSTRAINED_MINIMIZATION) {
216       ierr = SNESGetGradient(j->snes,&j->current_f,PETSC_NULL);CHKERRQ(ierr);
217     } else SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid method class");
218   }
219   PetscFunctionReturn(0);
220 }
221 
222 
223 #undef __FUNCT__
224 #define __FUNCT__ "MatSNESMFMult_Private"
225 /*
226   MatSNESMFMult_Private - Default matrix-free form for Jacobian-vector
227   product, y = F'(u)*a:
228 
229         y ~= (F(u + ha) - F(u))/h,
230   where F = nonlinear function, as set by SNESSetFunction()
231         u = current iterate
232         h = difference interval
233 */
234 int MatSNESMFMult_Private(Mat mat,Vec a,Vec y)
235 {
236   MatSNESMFCtx ctx;
237   SNES         snes;
238   Scalar       h,mone = -1.0;
239   Vec          w,U,F;
240   int          ierr,(*eval_fct)(SNES,Vec,Vec)=0;
241 
242   PetscFunctionBegin;
243   /* We log matrix-free matrix-vector products separately, so that we can
244      separate the performance monitoring from the cases that use conventional
245      storage.  We may eventually modify event logging to associate events
246      with particular objects, hence alleviating the more general problem. */
247   ierr = PetscLogEventBegin(MAT_MatrixFreeMult,a,y,0,0);CHKERRQ(ierr);
248 
249   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
250   snes = ctx->snes;
251   w    = ctx->w;
252   U    = ctx->current_u;
253 
254   /*
255       Compute differencing parameter
256   */
257   if (!ctx->ops->compute) {
258     ierr = MatSNESMFSetType(mat,MATSNESMF_DEFAULT);CHKERRQ(ierr);
259     ierr = MatSNESMFSetFromOptions(mat);CHKERRQ(ierr);
260   }
261   ierr = (*ctx->ops->compute)(ctx,U,a,&h);CHKERRQ(ierr);
262 
263   /* keep a record of the current differencing parameter h */
264   ctx->currenth = h;
265 #if defined(PETSC_USE_COMPLEX)
266   PetscLogInfo(mat,"MatSNESMFMult_Private:Current differencing parameter: %g + %g i\n",PetscRealPart(h),PetscImaginaryPart(h));
267 #else
268   PetscLogInfo(mat,"MatSNESMFMult_Private:Current differencing parameter: %15.12e\n",h);
269 #endif
270   if (ctx->historyh && ctx->ncurrenth < ctx->maxcurrenth) {
271     ctx->historyh[ctx->ncurrenth] = h;
272   }
273   ctx->ncurrenth++;
274 
275   /* w = u + ha */
276   ierr = VecWAXPY(&h,a,U,w);CHKERRQ(ierr);
277 
278   if (ctx->usesnes) {
279     if (snes->method_class == SNES_NONLINEAR_EQUATIONS) {
280       eval_fct = SNESComputeFunction;
281     } else if (snes->method_class == SNES_UNCONSTRAINED_MINIMIZATION) {
282       eval_fct = SNESComputeGradient;
283     } else SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid method class");
284     F    = ctx->current_f;
285     if (!F) SETERRQ(1,"You must call MatAssembly() even on matrix-free matrices");
286     ierr = (*eval_fct)(snes,w,y);CHKERRQ(ierr);
287   } else {
288     F = ctx->funcvec;
289     /* compute func(U) as base for differencing */
290     if (ctx->ncurrenth == 1) {
291       ierr = (*ctx->func)(snes,U,F,ctx->funcctx);CHKERRQ(ierr);
292     }
293     ierr = (*ctx->func)(snes,w,y,ctx->funcctx);CHKERRQ(ierr);
294   }
295 
296   ierr = VecAXPY(&mone,F,y);CHKERRQ(ierr);
297   h    = 1.0/h;
298   ierr = VecScale(&h,y);CHKERRQ(ierr);
299   if (ctx->sp) {ierr = MatNullSpaceRemove(ctx->sp,y,PETSC_NULL);CHKERRQ(ierr);}
300 
301   ierr = PetscLogEventEnd(MAT_MatrixFreeMult,a,y,0,0);CHKERRQ(ierr);
302   PetscFunctionReturn(0);
303 }
304 
305 #undef __FUNCT__
306 #define __FUNCT__ "MatCreateSNESMF"
307 /*@C
308    MatCreateSNESMF - Creates a matrix-free matrix context for use with
309    a SNES solver.  This matrix can be used as the Jacobian argument for
310    the routine SNESSetJacobian().
311 
312    Collective on SNES and Vec
313 
314    Input Parameters:
315 +  snes - the SNES context
316 -  x - vector where SNES solution is to be stored.
317 
318    Output Parameter:
319 .  J - the matrix-free matrix
320 
321    Level: advanced
322 
323    Notes:
324    The matrix-free matrix context merely contains the function pointers
325    and work space for performing finite difference approximations of
326    Jacobian-vector products, F'(u)*a,
327 
328    The default code uses the following approach to compute h
329 
330 .vb
331      F'(u)*a = [F(u+h*a) - F(u)]/h where
332      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
333        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   otherwise
334  where
335      error_rel = square root of relative error in function evaluation
336      umin = minimum iterate parameter
337 .ve
338 
339    The user can set the error_rel via MatSNESMFSetFunctionError() and
340    umin via MatSNESMFDefaultSetUmin(); see the nonlinear solvers chapter
341    of the users manual for details.
342 
343    The user should call MatDestroy() when finished with the matrix-free
344    matrix context.
345 
346    Options Database Keys:
347 +  -snes_mf_err <error_rel> - Sets error_rel
348 .  -snes_mf_unim <umin> - Sets umin (for default PETSc routine that computes h only)
349 -  -snes_mf_ksp_monitor - KSP monitor routine that prints differencing h
350 
351 .keywords: SNES, default, matrix-free, create, matrix
352 
353 .seealso: MatDestroy(), MatSNESMFSetFunctionError(), MatSNESMFDefaultSetUmin()
354           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(), MatCreateMF(),
355           MatSNESMFGetH(),MatSNESMFKSPMonitor(), MatSNESMFRegisterDynamic), MatSNESMFComputeJacobian()
356 
357 @*/
358 int MatCreateSNESMF(SNES snes,Vec x,Mat *J)
359 {
360   MatSNESMFCtx mfctx;
361   int          ierr;
362 
363   PetscFunctionBegin;
364   ierr = MatCreateMF(x,J);CHKERRQ(ierr);
365   ierr = MatShellGetContext(*J,(void **)&mfctx);CHKERRQ(ierr);
366   mfctx->snes    = snes;
367   mfctx->usesnes = PETSC_TRUE;
368   PetscLogObjectParent(snes,*J);
369   PetscFunctionReturn(0);
370 }
371 
372 EXTERN_C_BEGIN
373 #undef __FUNCT__
374 #define __FUNCT__ "MatSNESMFSetBase_FD"
375 int MatSNESMFSetBase_FD(Mat J,Vec U)
376 {
377   int          ierr;
378   MatSNESMFCtx ctx;
379 
380   PetscFunctionBegin;
381   ierr = MatSNESMFResetHHistory(J);CHKERRQ(ierr);
382   ierr = MatShellGetContext(J,(void **)&ctx);CHKERRQ(ierr);
383   ctx->current_u = U;
384   ctx->usesnes   = PETSC_FALSE;
385   PetscFunctionReturn(0);
386 }
387 EXTERN_C_END
388 
389 #undef __FUNCT__
390 #define __FUNCT__ "MatCreateMF"
391 /*@C
392    MatCreateMF - Creates a matrix-free matrix. See also MatCreateSNESMF()
393 
394    Collective on Vec
395 
396    Input Parameters:
397 .  x - vector that defines layout of the vectors and matrices
398 
399    Output Parameter:
400 .  J - the matrix-free matrix
401 
402    Level: advanced
403 
404    Notes:
405    The matrix-free matrix context merely contains the function pointers
406    and work space for performing finite difference approximations of
407    Jacobian-vector products, F'(u)*a,
408 
409    The default code uses the following approach to compute h
410 
411 .vb
412      F'(u)*a = [F(u+h*a) - F(u)]/h where
413      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
414        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   otherwise
415  where
416      error_rel = square root of relative error in function evaluation
417      umin = minimum iterate parameter
418 .ve
419 
420    The user can set the error_rel via MatSNESMFSetFunctionError() and
421    umin via MatSNESMFDefaultSetUmin(); see the nonlinear solvers chapter
422    of the users manual for details.
423 
424    The user should call MatDestroy() when finished with the matrix-free
425    matrix context.
426 
427    Options Database Keys:
428 +  -snes_mf_err <error_rel> - Sets error_rel
429 .  -snes_mf_unim <umin> - Sets umin (for default PETSc routine that computes h only)
430 -  -snes_mf_ksp_monitor - KSP monitor routine that prints differencing h
431 
432 .keywords: default, matrix-free, create, matrix
433 
434 .seealso: MatDestroy(), MatSNESMFSetFunctionError(), MatSNESMFDefaultSetUmin()
435           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(), MatCreateSNESMF(),
436           MatSNESMFGetH(),MatSNESMFKSPMonitor(), MatSNESMFRegisterDynamic),, MatSNESMFComputeJacobian()
437 
438 @*/
439 int MatCreateMF(Vec x,Mat *J)
440 {
441   MPI_Comm     comm;
442   MatSNESMFCtx mfctx;
443   int          n,nloc,ierr;
444 
445   PetscFunctionBegin;
446   ierr = PetscObjectGetComm((PetscObject)x,&comm);CHKERRQ(ierr);
447   PetscHeaderCreate(mfctx,_p_MatSNESMFCtx,struct _MFOps,MATSNESMFCTX_COOKIE,0,"SNESMF",comm,MatSNESMFDestroy_Private,MatSNESMFView_Private);
448   PetscLogObjectCreate(mfctx);
449   mfctx->sp              = 0;
450   mfctx->snes            = 0;
451   mfctx->error_rel       = 1.e-8; /* assumes PetscReal precision */
452   mfctx->recomputeperiod = 1;
453   mfctx->count           = 0;
454   mfctx->currenth        = 0.0;
455   mfctx->historyh        = PETSC_NULL;
456   mfctx->ncurrenth       = 0;
457   mfctx->maxcurrenth     = 0;
458   mfctx->type_name       = 0;
459   mfctx->usesnes         = PETSC_FALSE;
460 
461   /*
462      Create the empty data structure to contain compute-h routines.
463      These will be filled in below from the command line options or
464      a later call with MatSNESMFSetType() or if that is not called
465      then it will default in the first use of MatSNESMFMult_private()
466   */
467   mfctx->ops->compute        = 0;
468   mfctx->ops->destroy        = 0;
469   mfctx->ops->view           = 0;
470   mfctx->ops->setfromoptions = 0;
471   mfctx->hctx                = 0;
472 
473   mfctx->func                = 0;
474   mfctx->funcctx             = 0;
475   mfctx->funcvec             = 0;
476 
477   ierr = VecDuplicate(x,&mfctx->w);CHKERRQ(ierr);
478   ierr = VecGetSize(mfctx->w,&n);CHKERRQ(ierr);
479   ierr = VecGetLocalSize(mfctx->w,&nloc);CHKERRQ(ierr);
480   ierr = MatCreateShell(comm,nloc,nloc,n,n,mfctx,J);CHKERRQ(ierr);
481   ierr = MatShellSetOperation(*J,MATOP_MULT,(void(*)())MatSNESMFMult_Private);CHKERRQ(ierr);
482   ierr = MatShellSetOperation(*J,MATOP_DESTROY,(void(*)())MatSNESMFDestroy_Private);CHKERRQ(ierr);
483   ierr = MatShellSetOperation(*J,MATOP_VIEW,(void(*)())MatSNESMFView_Private);CHKERRQ(ierr);
484   ierr = MatShellSetOperation(*J,MATOP_ASSEMBLY_END,(void(*)())MatSNESMFAssemblyEnd_Private);CHKERRQ(ierr);
485   ierr = PetscObjectComposeFunctionDynamic((PetscObject)*J,"MatSNESMFSetBase_C","MatSNESMFSetBase_FD",MatSNESMFSetBase_FD);CHKERRQ(ierr);
486   PetscLogObjectParent(*J,mfctx->w);
487 
488   mfctx->mat = *J;
489   PetscFunctionReturn(0);
490 }
491 
492 #undef __FUNCT__
493 #define __FUNCT__ "MatSNESMFSetFromOptions"
494 /*@
495    MatSNESMFSetFromOptions - Sets the MatSNESMF options from the command line
496    parameter.
497 
498    Collective on Mat
499 
500    Input Parameters:
501 .  mat - the matrix obtained with MatCreateSNESMF()
502 
503    Options Database Keys:
504 +  -snes_mf_type - <default,wp>
505 -  -snes_mf_err - square root of estimated relative error in function evaluation
506 -  -snes_mf_period - how often h is recomputed, defaults to 1, everytime
507 
508    Level: advanced
509 
510 .keywords: SNES, matrix-free, parameters
511 
512 .seealso: MatCreateSNESMF(),MatSNESMFSetHHistory(),
513           MatSNESMFResetHHistory(), MatSNESMFKSPMonitor()
514 @*/
515 int MatSNESMFSetFromOptions(Mat mat)
516 {
517   MatSNESMFCtx mfctx;
518   int          ierr;
519   PetscTruth   flg;
520   char         ftype[256];
521 
522   PetscFunctionBegin;
523   ierr = MatShellGetContext(mat,(void **)&mfctx);CHKERRQ(ierr);
524   if (mfctx) {
525     if (!MatSNESMFRegisterAllCalled) {ierr = MatSNESMFRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
526 
527     ierr = PetscOptionsBegin(mfctx->comm,mfctx->prefix,"Set matrix free computation parameters","MatSNESMF");CHKERRQ(ierr);
528       ierr = PetscOptionsList("-snes_mf_type","Matrix free type","MatSNESMFSetType",MatSNESMPetscFList,mfctx->type_name,ftype,256,&flg);CHKERRQ(ierr);
529       if (flg) {
530         ierr = MatSNESMFSetType(mat,ftype);CHKERRQ(ierr);
531       }
532 
533       ierr = PetscOptionsDouble("-snes_mf_err","set sqrt relative error in function","MatSNESMFSetFunctionError",mfctx->error_rel,&mfctx->error_rel,0);CHKERRQ(ierr);
534       ierr = PetscOptionsInt("-snes_mf_period","how often h is recomputed","MatSNESMFSetPeriod",mfctx->recomputeperiod,&mfctx->recomputeperiod,0);CHKERRQ(ierr);
535       if (mfctx->snes) {
536         ierr = PetscOptionsName("-snes_mf_ksp_monitor","Monitor matrix-free parameters","MatSNESMFKSPMonitor",&flg);CHKERRQ(ierr);
537         if (flg) {
538           SLES sles;
539           KSP  ksp;
540           ierr = SNESGetSLES(mfctx->snes,&sles);CHKERRQ(ierr);
541           ierr = SLESGetKSP(sles,&ksp);CHKERRQ(ierr);
542           ierr = KSPSetMonitor(ksp,MatSNESMFKSPMonitor,PETSC_NULL,0);CHKERRQ(ierr);
543         }
544       }
545       if (mfctx->ops->setfromoptions) {
546         ierr = (*mfctx->ops->setfromoptions)(mfctx);CHKERRQ(ierr);
547       }
548     ierr = PetscOptionsEnd();CHKERRQ(ierr);
549 
550   }
551   PetscFunctionReturn(0);
552 }
553 
554 #undef __FUNCT__
555 #define __FUNCT__ "MatSNESMFGetH"
556 /*@
557    MatSNESMFGetH - Gets the last value that was used as the differencing
558    parameter.
559 
560    Not Collective
561 
562    Input Parameters:
563 .  mat - the matrix obtained with MatCreateSNESMF()
564 
565    Output Paramter:
566 .  h - the differencing step size
567 
568    Level: advanced
569 
570 .keywords: SNES, matrix-free, parameters
571 
572 .seealso: MatCreateSNESMF(),MatSNESMFSetHHistory(),
573           MatSNESMFResetHHistory(),MatSNESMFKSPMonitor()
574 @*/
575 int MatSNESMFGetH(Mat mat,Scalar *h)
576 {
577   MatSNESMFCtx ctx;
578   int          ierr;
579 
580   PetscFunctionBegin;
581   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
582   if (ctx) {
583     *h = ctx->currenth;
584   }
585   PetscFunctionReturn(0);
586 }
587 
588 #undef __FUNCT__
589 #define __FUNCT__ "MatSNESMFKSPMonitor"
590 /*
591    MatSNESMFKSPMonitor - A KSP monitor for use with the default PETSc
592    SNES matrix free routines. Prints the differencing parameter used at
593    each step.
594 */
595 int MatSNESMFKSPMonitor(KSP ksp,int n,PetscReal rnorm,void *dummy)
596 {
597   PC             pc;
598   MatSNESMFCtx   ctx;
599   int            ierr;
600   Mat            mat;
601   MPI_Comm       comm;
602   PetscTruth     nonzeroinitialguess;
603 
604   PetscFunctionBegin;
605   ierr = PetscObjectGetComm((PetscObject)ksp,&comm);CHKERRQ(ierr);
606   ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
607   ierr = KSPGetInitialGuessNonzero(ksp,&nonzeroinitialguess);CHKERRQ(ierr);
608   ierr = PCGetOperators(pc,&mat,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
609   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
610   if (!ctx) {
611     SETERRQ(1,"Matrix is not a matrix free shell matrix");
612   }
613   if (n > 0 || nonzeroinitialguess) {
614 #if defined(PETSC_USE_COMPLEX)
615     ierr = PetscPrintf(comm,"%d KSP Residual norm %14.12e h %g + %g i\n",n,rnorm,
616                 PetscRealPart(ctx->currenth),PetscImaginaryPart(ctx->currenth));CHKERRQ(ierr);
617 #else
618     ierr = PetscPrintf(comm,"%d KSP Residual norm %14.12e h %g \n",n,rnorm,ctx->currenth);CHKERRQ(ierr);
619 #endif
620   } else {
621     ierr = PetscPrintf(comm,"%d KSP Residual norm %14.12e\n",n,rnorm);CHKERRQ(ierr);
622   }
623   PetscFunctionReturn(0);
624 }
625 
626 #undef __FUNCT__
627 #define __FUNCT__ "MatSNESMFSetFunction"
628 /*@C
629    MatSNESMFSetFunction - Sets the function used in applying the matrix free.
630 
631    Collective on Mat
632 
633    Input Parameters:
634 +  mat - the matrix free matrix created via MatCreateSNESMF()
635 .  v   - workspace vector
636 .  func - the function to use
637 -  funcctx - optional function context passed to function
638 
639    Level: advanced
640 
641    Notes:
642     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
643     matrix inside your compute Jacobian routine
644 
645     If this is not set then it will use the function set with SNESSetFunction()
646 
647 .keywords: SNES, matrix-free, function
648 
649 .seealso: MatCreateSNESMF(),MatSNESMFGetH(),
650           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(),
651           MatSNESMFKSPMonitor(), SNESetFunction()
652 @*/
653 int MatSNESMFSetFunction(Mat mat,Vec v,int (*func)(SNES,Vec,Vec,void *),void *funcctx)
654 {
655   MatSNESMFCtx ctx;
656   int          ierr;
657 
658   PetscFunctionBegin;
659   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
660   if (ctx) {
661     ctx->func    = func;
662     ctx->funcctx = funcctx;
663     ctx->funcvec = v;
664   }
665   PetscFunctionReturn(0);
666 }
667 
668 
669 #undef __FUNCT__
670 #define __FUNCT__ "MatSNESMFSetPeriod"
671 /*@
672    MatSNESMFSetPeriod - Sets how often h is recomputed, by default it is everytime
673 
674    Collective on Mat
675 
676    Input Parameters:
677 +  mat - the matrix free matrix created via MatCreateSNESMF()
678 -  period - 1 for everytime, 2 for every second etc
679 
680    Options Database Keys:
681 +  -snes_mf_period <period>
682 
683    Level: advanced
684 
685 
686 .keywords: SNES, matrix-free, parameters
687 
688 .seealso: MatCreateSNESMF(),MatSNESMFGetH(),
689           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(),
690           MatSNESMFKSPMonitor()
691 @*/
692 int MatSNESMFSetPeriod(Mat mat,int period)
693 {
694   MatSNESMFCtx ctx;
695   int          ierr;
696 
697   PetscFunctionBegin;
698   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
699   if (ctx) {
700     ctx->recomputeperiod = period;
701   }
702   PetscFunctionReturn(0);
703 }
704 
705 #undef __FUNCT__
706 #define __FUNCT__ "MatSNESMFSetFunctionError"
707 /*@
708    MatSNESMFSetFunctionError - Sets the error_rel for the approximation of
709    matrix-vector products using finite differences.
710 
711    Collective on Mat
712 
713    Input Parameters:
714 +  mat - the matrix free matrix created via MatCreateSNESMF()
715 -  error_rel - relative error (should be set to the square root of
716                the relative error in the function evaluations)
717 
718    Options Database Keys:
719 +  -snes_mf_err <error_rel> - Sets error_rel
720 
721    Level: advanced
722 
723    Notes:
724    The default matrix-free matrix-vector product routine computes
725 .vb
726      F'(u)*a = [F(u+h*a) - F(u)]/h where
727      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
728        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   else
729 .ve
730 
731 .keywords: SNES, matrix-free, parameters
732 
733 .seealso: MatCreateSNESMF(),MatSNESMFGetH(),
734           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(),
735           MatSNESMFKSPMonitor()
736 @*/
737 int MatSNESMFSetFunctionError(Mat mat,PetscReal error)
738 {
739   MatSNESMFCtx ctx;
740   int          ierr;
741 
742   PetscFunctionBegin;
743   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
744   if (ctx) {
745     if (error != PETSC_DEFAULT) ctx->error_rel = error;
746   }
747   PetscFunctionReturn(0);
748 }
749 
750 #undef __FUNCT__
751 #define __FUNCT__ "MatSNESMFAddNullSpace"
752 /*@
753    MatSNESMFAddNullSpace - Provides a null space that an operator is
754    supposed to have.  Since roundoff will create a small component in
755    the null space, if you know the null space you may have it
756    automatically removed.
757 
758    Collective on Mat
759 
760    Input Parameters:
761 +  J - the matrix-free matrix context
762 -  nullsp - object created with MatNullSpaceCreate()
763 
764    Level: advanced
765 
766 .keywords: SNES, matrix-free, null space
767 
768 .seealso: MatNullSpaceCreate(), MatSNESMFGetH(), MatCreateSNESMF(),
769           MatSNESMFSetHHistory(), MatSNESMFResetHHistory(),
770           MatSNESMFKSPMonitor(), MatSNESMFErrorRel()
771 @*/
772 int MatSNESMFAddNullSpace(Mat J,MatNullSpace nullsp)
773 {
774   int          ierr;
775   MatSNESMFCtx ctx;
776   MPI_Comm     comm;
777 
778   PetscFunctionBegin;
779   ierr = PetscObjectGetComm((PetscObject)J,&comm);CHKERRQ(ierr);
780 
781   ierr = MatShellGetContext(J,(void **)&ctx);CHKERRQ(ierr);
782   /* no context indicates that it is not the "matrix free" matrix type */
783   if (!ctx) PetscFunctionReturn(0);
784   ctx->sp = nullsp;
785   ierr = PetscObjectReference((PetscObject)nullsp);CHKERRQ(ierr);
786   PetscFunctionReturn(0);
787 }
788 
789 #undef __FUNCT__
790 #define __FUNCT__ "MatSNESMFSetHHistory"
791 /*@
792    MatSNESMFSetHHistory - Sets an array to collect a history of the
793    differencing values (h) computed for the matrix-free product.
794 
795    Collective on Mat
796 
797    Input Parameters:
798 +  J - the matrix-free matrix context
799 .  histroy - space to hold the history
800 -  nhistory - number of entries in history, if more entries are generated than
801               nhistory, then the later ones are discarded
802 
803    Level: advanced
804 
805    Notes:
806    Use MatSNESMFResetHHistory() to reset the history counter and collect
807    a new batch of differencing parameters, h.
808 
809 .keywords: SNES, matrix-free, h history, differencing history
810 
811 .seealso: MatSNESMFGetH(), MatCreateSNESMF(),
812           MatSNESMFResetHHistory(),
813           MatSNESMFKSPMonitor(), MatSNESMFSetFunctionError()
814 
815 @*/
816 int MatSNESMFSetHHistory(Mat J,Scalar *history,int nhistory)
817 {
818   int          ierr;
819   MatSNESMFCtx ctx;
820 
821   PetscFunctionBegin;
822 
823   ierr = MatShellGetContext(J,(void **)&ctx);CHKERRQ(ierr);
824   /* no context indicates that it is not the "matrix free" matrix type */
825   if (!ctx) PetscFunctionReturn(0);
826   ctx->historyh    = history;
827   ctx->maxcurrenth = nhistory;
828   ctx->currenth    = 0;
829 
830   PetscFunctionReturn(0);
831 }
832 
833 #undef __FUNCT__
834 #define __FUNCT__ "MatSNESMFResetHHistory"
835 /*@
836    MatSNESMFResetHHistory - Resets the counter to zero to begin
837    collecting a new set of differencing histories.
838 
839    Collective on Mat
840 
841    Input Parameters:
842 .  J - the matrix-free matrix context
843 
844    Level: advanced
845 
846    Notes:
847    Use MatSNESMFSetHHistory() to create the original history counter.
848 
849 .keywords: SNES, matrix-free, h history, differencing history
850 
851 .seealso: MatSNESMFGetH(), MatCreateSNESMF(),
852           MatSNESMFSetHHistory(),
853           MatSNESMFKSPMonitor(), MatSNESMFSetFunctionError()
854 
855 @*/
856 int MatSNESMFResetHHistory(Mat J)
857 {
858   int          ierr;
859   MatSNESMFCtx ctx;
860 
861   PetscFunctionBegin;
862 
863   ierr = MatShellGetContext(J,(void **)&ctx);CHKERRQ(ierr);
864   /* no context indicates that it is not the "matrix free" matrix type */
865   if (!ctx) PetscFunctionReturn(0);
866   ctx->ncurrenth    = 0;
867 
868   PetscFunctionReturn(0);
869 }
870 
871 #undef __FUNCT__
872 #define __FUNCT__ "MatSNESMFComputeJacobian"
873 int MatSNESMFComputeJacobian(SNES snes,Vec x,Mat *jac,Mat *B,MatStructure *flag,void *dummy)
874 {
875   int ierr;
876   PetscFunctionBegin;
877   ierr = MatAssemblyBegin(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
878   ierr = MatAssemblyEnd(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
879   PetscFunctionReturn(0);
880 }
881 
882 #undef __FUNCT__
883 #define __FUNCT__ "MatSNESMFSetBase"
884 int MatSNESMFSetBase(Mat J,Vec U)
885 {
886   int  ierr,(*f)(Mat,Vec);
887 
888   PetscFunctionBegin;
889   PetscValidHeaderSpecific(J,MAT_COOKIE);
890   PetscValidHeaderSpecific(U,VEC_COOKIE);
891   ierr = PetscObjectQueryFunction((PetscObject)J,"MatSNESMFSetBase_C",(void (**)())&f);CHKERRQ(ierr);
892   if (f) {
893     ierr = (*f)(J,U);CHKERRQ(ierr);
894   }
895   PetscFunctionReturn(0);
896 }
897