Actual source code: mffd.c
 
   petsc-3.6.2 2015-10-02
   
  2: #include <petsc/private/matimpl.h>
  3: #include <../src/mat/impls/mffd/mffdimpl.h>   /*I  "petscmat.h"   I*/
  5: PetscFunctionList MatMFFDList              = 0;
  6: PetscBool         MatMFFDRegisterAllCalled = PETSC_FALSE;
  8: PetscClassId  MATMFFD_CLASSID;
  9: PetscLogEvent MATMFFD_Mult;
 11: static PetscBool MatMFFDPackageInitialized = PETSC_FALSE;
 14: /*@C
 15:   MatMFFDFinalizePackage - This function destroys everything in the MatMFFD package. It is
 16:   called from PetscFinalize().
 18:   Level: developer
 20: .keywords: Petsc, destroy, package
 21: .seealso: PetscFinalize()
 22: @*/
 23: PetscErrorCode  MatMFFDFinalizePackage(void)
 24: {
 28:   PetscFunctionListDestroy(&MatMFFDList);
 29:   MatMFFDPackageInitialized = PETSC_FALSE;
 30:   MatMFFDRegisterAllCalled  = PETSC_FALSE;
 31:   return(0);
 32: }
 36: /*@C
 37:   MatMFFDInitializePackage - This function initializes everything in the MatMFFD package. It is called
 38:   from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to MatCreate_MFFD()
 39:   when using static libraries.
 41:   Level: developer
 43: .keywords: Vec, initialize, package
 44: .seealso: PetscInitialize()
 45: @*/
 46: PetscErrorCode  MatMFFDInitializePackage(void)
 47: {
 48:   char           logList[256];
 49:   char           *className;
 50:   PetscBool      opt;
 54:   if (MatMFFDPackageInitialized) return(0);
 55:   MatMFFDPackageInitialized = PETSC_TRUE;
 56:   /* Register Classes */
 57:   PetscClassIdRegister("MatMFFD",&MATMFFD_CLASSID);
 58:   /* Register Constructors */
 59:   MatMFFDRegisterAll();
 60:   /* Register Events */
 61:   PetscLogEventRegister("MatMult MF",          MATMFFD_CLASSID,&MATMFFD_Mult);
 63:   /* Process info exclusions */
 64:   PetscOptionsGetString(NULL, "-info_exclude", logList, 256, &opt);
 65:   if (opt) {
 66:     PetscStrstr(logList, "matmffd", &className);
 67:     if (className) {
 68:       PetscInfoDeactivateClass(MATMFFD_CLASSID);
 69:     }
 70:   }
 71:   /* Process summary exclusions */
 72:   PetscOptionsGetString(NULL, "-log_summary_exclude", logList, 256, &opt);
 73:   if (opt) {
 74:     PetscStrstr(logList, "matmffd", &className);
 75:     if (className) {
 76:       PetscLogEventDeactivateClass(MATMFFD_CLASSID);
 77:     }
 78:   }
 79:   PetscRegisterFinalize(MatMFFDFinalizePackage);
 80:   return(0);
 81: }
 85: /*@C
 86:     MatMFFDSetType - Sets the method that is used to compute the
 87:     differencing parameter for finite differene matrix-free formulations.
 89:     Input Parameters:
 90: +   mat - the "matrix-free" matrix created via MatCreateSNESMF(), or MatCreateMFFD()
 91:           or MatSetType(mat,MATMFFD);
 92: -   ftype - the type requested, either MATMFFD_WP or MATMFFD_DS
 94:     Level: advanced
 96:     Notes:
 97:     For example, such routines can compute h for use in
 98:     Jacobian-vector products of the form
100:                         F(x+ha) - F(x)
101:           F'(u)a  ~=  ----------------
102:                               h
104: .seealso: MatCreateSNESMF(), MatMFFDRegister(), MatMFFDSetFunction()
105: @*/
106: PetscErrorCode  MatMFFDSetType(Mat mat,MatMFFDType ftype)
107: {
108:   PetscErrorCode ierr,(*r)(MatMFFD);
109:   MatMFFD        ctx = (MatMFFD)mat->data;
110:   PetscBool      match;
116:   PetscObjectTypeCompare((PetscObject)mat,MATMFFD,&match);
117:   if (!match) return(0);
119:   /* already set, so just return */
120:   PetscObjectTypeCompare((PetscObject)ctx,ftype,&match);
121:   if (match) return(0);
123:   /* destroy the old one if it exists */
124:   if (ctx->ops->destroy) {
125:     (*ctx->ops->destroy)(ctx);
126:   }
128:    PetscFunctionListFind(MatMFFDList,ftype,&r);
129:   if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown MatMFFD type %s given",ftype);
130:   (*r)(ctx);
131:   PetscObjectChangeTypeName((PetscObject)ctx,ftype);
132:   return(0);
133: }
135: typedef PetscErrorCode (*FCN1)(void*,Vec); /* force argument to next function to not be extern C*/
138: PetscErrorCode  MatMFFDSetFunctioniBase_MFFD(Mat mat,FCN1 func)
139: {
140:   MatMFFD ctx = (MatMFFD)mat->data;
143:   ctx->funcisetbase = func;
144:   return(0);
145: }
147: typedef PetscErrorCode (*FCN2)(void*,PetscInt,Vec,PetscScalar*); /* force argument to next function to not be extern C*/
150: PetscErrorCode  MatMFFDSetFunctioni_MFFD(Mat mat,FCN2 funci)
151: {
152:   MatMFFD ctx = (MatMFFD)mat->data;
155:   ctx->funci = funci;
156:   return(0);
157: }
161: PetscErrorCode  MatMFFDResetHHistory_MFFD(Mat J)
162: {
163:   MatMFFD ctx = (MatMFFD)J->data;
166:   ctx->ncurrenth = 0;
167:   return(0);
168: }
172: /*@C
173:    MatMFFDRegister - Adds a method to the MatMFFD registry.
175:    Not Collective
177:    Input Parameters:
178: +  name_solver - name of a new user-defined compute-h module
179: -  routine_create - routine to create method context
181:    Level: developer
183:    Notes:
184:    MatMFFDRegister() may be called multiple times to add several user-defined solvers.
186:    Sample usage:
187: .vb
188:    MatMFFDRegister("my_h",MyHCreate);
189: .ve
191:    Then, your solver can be chosen with the procedural interface via
192: $     MatMFFDSetType(mfctx,"my_h")
193:    or at runtime via the option
194: $     -mat_mffd_type my_h
196: .keywords: MatMFFD, register
198: .seealso: MatMFFDRegisterAll(), MatMFFDRegisterDestroy()
199:  @*/
200: PetscErrorCode  MatMFFDRegister(const char sname[],PetscErrorCode (*function)(MatMFFD))
201: {
205:   PetscFunctionListAdd(&MatMFFDList,sname,function);
206:   return(0);
207: }
209: /* ----------------------------------------------------------------------------------------*/
212: PetscErrorCode MatDestroy_MFFD(Mat mat)
213: {
215:   MatMFFD        ctx = (MatMFFD)mat->data;
218:   VecDestroy(&ctx->w);
219:   VecDestroy(&ctx->drscale);
220:   VecDestroy(&ctx->dlscale);
221:   VecDestroy(&ctx->dshift);
222:   if (ctx->current_f_allocated) {
223:     VecDestroy(&ctx->current_f);
224:   }
225:   if (ctx->ops->destroy) {(*ctx->ops->destroy)(ctx);}
226:   PetscHeaderDestroy(&ctx);
227:   mat->data = 0;
229:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetBase_C",NULL);
230:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctioniBase_C",NULL);
231:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctioni_C",NULL);
232:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunction_C",NULL);
233:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctionError_C",NULL);
234:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetCheckh_C",NULL);
235:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetPeriod_C",NULL);
236:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDResetHHistory_C",NULL);
237:   return(0);
238: }
242: /*
243:    MatMFFDView_MFFD - Views matrix-free parameters.
245: */
246: PetscErrorCode MatView_MFFD(Mat J,PetscViewer viewer)
247: {
249:   MatMFFD        ctx = (MatMFFD)J->data;
250:   PetscBool      iascii, viewbase, viewfunction;
251:   const char     *prefix;
254:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
255:   if (iascii) {
256:     PetscViewerASCIIPrintf(viewer,"Matrix-free approximation:\n");
257:     PetscViewerASCIIPushTab(viewer);
258:     PetscViewerASCIIPrintf(viewer,"err=%g (relative error in function evaluation)\n",(double)ctx->error_rel);
259:     if (!((PetscObject)ctx)->type_name) {
260:       PetscViewerASCIIPrintf(viewer,"The compute h routine has not yet been set\n");
261:     } else {
262:       PetscViewerASCIIPrintf(viewer,"Using %s compute h routine\n",((PetscObject)ctx)->type_name);
263:     }
264:     if (ctx->ops->view) {
265:       (*ctx->ops->view)(ctx,viewer);
266:     }
267:     PetscObjectGetOptionsPrefix((PetscObject)J, &prefix);
269:     PetscOptionsHasName(prefix, "-mat_mffd_view_base", &viewbase);
270:     if (viewbase) {
271:       PetscViewerASCIIPrintf(viewer, "Base:\n");
272:       VecView(ctx->current_u, viewer);
273:     }
274:     PetscOptionsHasName(prefix, "-mat_mffd_view_function", &viewfunction);
275:     if (viewfunction) {
276:       PetscViewerASCIIPrintf(viewer, "Function:\n");
277:       VecView(ctx->current_f, viewer);
278:     }
279:     PetscViewerASCIIPopTab(viewer);
280:   }
281:   return(0);
282: }
286: /*
287:    MatAssemblyEnd_MFFD - Resets the ctx->ncurrenth to zero. This
288:    allows the user to indicate the beginning of a new linear solve by calling
289:    MatAssemblyXXX() on the matrix free matrix. This then allows the
290:    MatCreateMFFD_WP() to properly compute ||U|| only the first time
291:    in the linear solver rather than every time.
293:    This function is referenced directly from MatAssemblyEnd_SNESMF(), which may be in a different shared library.
294: */
295: PETSC_EXTERN PetscErrorCode MatAssemblyEnd_MFFD(Mat J,MatAssemblyType mt)
296: {
298:   MatMFFD        j = (MatMFFD)J->data;
301:   MatMFFDResetHHistory(J);
302:   j->vshift = 0.0;
303:   j->vscale = 1.0;
304:   return(0);
305: }
309: /*
310:   MatMult_MFFD - Default matrix-free form for Jacobian-vector product, y = F'(u)*a:
312:         y ~= (F(u + ha) - F(u))/h,
313:   where F = nonlinear function, as set by SNESSetFunction()
314:         u = current iterate
315:         h = difference interval
316: */
317: PetscErrorCode MatMult_MFFD(Mat mat,Vec a,Vec y)
318: {
319:   MatMFFD        ctx = (MatMFFD)mat->data;
320:   PetscScalar    h;
321:   Vec            w,U,F;
323:   PetscBool      zeroa;
326:   if (!ctx->current_u) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"MatMFFDSetBase() has not been called, this is often caused by forgetting to call \n\t\tMatAssemblyBegin/End on the first Mat in the SNES compute function");
327:   /* We log matrix-free matrix-vector products separately, so that we can
328:      separate the performance monitoring from the cases that use conventional
329:      storage.  We may eventually modify event logging to associate events
330:      with particular objects, hence alleviating the more general problem. */
331:   PetscLogEventBegin(MATMFFD_Mult,a,y,0,0);
333:   w = ctx->w;
334:   U = ctx->current_u;
335:   F = ctx->current_f;
336:   /*
337:       Compute differencing parameter
338:   */
339:   if (!ctx->ops->compute) {
340:     MatMFFDSetType(mat,MATMFFD_WP);
341:     MatSetFromOptions(mat);
342:   }
343:   (*ctx->ops->compute)(ctx,U,a,&h,&zeroa);
344:   if (zeroa) {
345:     VecSet(y,0.0);
346:     return(0);
347:   }
349:   if (mat->erroriffpe && PetscIsInfOrNanScalar(h)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed Nan differencing parameter h");
350:   if (ctx->checkh) {
351:     (*ctx->checkh)(ctx->checkhctx,U,a,&h);
352:   }
354:   /* keep a record of the current differencing parameter h */
355:   ctx->currenth = h;
356: #if defined(PETSC_USE_COMPLEX)
357:   PetscInfo2(mat,"Current differencing parameter: %g + %g i\n",(double)PetscRealPart(h),(double)PetscImaginaryPart(h));
358: #else
359:   PetscInfo1(mat,"Current differencing parameter: %15.12e\n",h);
360: #endif
361:   if (ctx->historyh && ctx->ncurrenth < ctx->maxcurrenth) {
362:     ctx->historyh[ctx->ncurrenth] = h;
363:   }
364:   ctx->ncurrenth++;
366:   /* w = u + ha */
367:   if (ctx->drscale) {
368:     VecPointwiseMult(ctx->drscale,a,U);
369:     VecAYPX(U,h,w);
370:   } else {
371:     VecWAXPY(w,h,a,U);
372:   }
374:   /* compute func(U) as base for differencing; only needed first time in and not when provided by user */
375:   if (ctx->ncurrenth == 1 && ctx->current_f_allocated) {
376:     (*ctx->func)(ctx->funcctx,U,F);
377:   }
378:   (*ctx->func)(ctx->funcctx,w,y);
380:   VecAXPY(y,-1.0,F);
381:   VecScale(y,1.0/h);
383:   if ((ctx->vshift != 0.0) || (ctx->vscale != 1.0)) {
384:     VecAXPBY(y,ctx->vshift,ctx->vscale,a);
385:   }
386:   if (ctx->dlscale) {
387:     VecPointwiseMult(y,ctx->dlscale,y);
388:   }
389:   if (ctx->dshift) {
390:     VecPointwiseMult(ctx->dshift,a,U);
391:     VecAXPY(y,1.0,U);
392:   }
394:   if (mat->nullsp) {MatNullSpaceRemove(mat->nullsp,y);}
396:   PetscLogEventEnd(MATMFFD_Mult,a,y,0,0);
397:   return(0);
398: }
402: /*
403:   MatGetDiagonal_MFFD - Gets the diagonal for a matrix free matrix
405:         y ~= (F(u + ha) - F(u))/h,
406:   where F = nonlinear function, as set by SNESSetFunction()
407:         u = current iterate
408:         h = difference interval
409: */
410: PetscErrorCode MatGetDiagonal_MFFD(Mat mat,Vec a)
411: {
412:   MatMFFD        ctx = (MatMFFD)mat->data;
413:   PetscScalar    h,*aa,*ww,v;
414:   PetscReal      epsilon = PETSC_SQRT_MACHINE_EPSILON,umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
415:   Vec            w,U;
417:   PetscInt       i,rstart,rend;
420:   if (!ctx->funci) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Requires calling MatMFFDSetFunctioni() first");
422:   w    = ctx->w;
423:   U    = ctx->current_u;
424:   (*ctx->func)(ctx->funcctx,U,a);
425:   (*ctx->funcisetbase)(ctx->funcctx,U);
426:   VecCopy(U,w);
428:   VecGetOwnershipRange(a,&rstart,&rend);
429:   VecGetArray(a,&aa);
430:   for (i=rstart; i<rend; i++) {
431:     VecGetArray(w,&ww);
432:     h    = ww[i-rstart];
433:     if (h == 0.0) h = 1.0;
434:     if (PetscAbsScalar(h) < umin && PetscRealPart(h) >= 0.0)     h = umin;
435:     else if (PetscRealPart(h) < 0.0 && PetscAbsScalar(h) < umin) h = -umin;
436:     h *= epsilon;
438:     ww[i-rstart] += h;
439:     VecRestoreArray(w,&ww);
440:     (*ctx->funci)(ctx->funcctx,i,w,&v);
441:     aa[i-rstart]  = (v - aa[i-rstart])/h;
443:     /* possibly shift and scale result */
444:     if ((ctx->vshift != 0.0) || (ctx->vscale != 1.0)) {
445:       aa[i - rstart] = ctx->vshift + ctx->vscale*aa[i-rstart];
446:     }
448:     VecGetArray(w,&ww);
449:     ww[i-rstart] -= h;
450:     VecRestoreArray(w,&ww);
451:   }
452:   VecRestoreArray(a,&aa);
453:   return(0);
454: }
458: PetscErrorCode MatDiagonalScale_MFFD(Mat mat,Vec ll,Vec rr)
459: {
460:   MatMFFD        aij = (MatMFFD)mat->data;
464:   if (ll && !aij->dlscale) {
465:     VecDuplicate(ll,&aij->dlscale);
466:   }
467:   if (rr && !aij->drscale) {
468:     VecDuplicate(rr,&aij->drscale);
469:   }
470:   if (ll) {
471:     VecCopy(ll,aij->dlscale);
472:   }
473:   if (rr) {
474:     VecCopy(rr,aij->drscale);
475:   }
476:   return(0);
477: }
481: PetscErrorCode MatDiagonalSet_MFFD(Mat mat,Vec ll,InsertMode mode)
482: {
483:   MatMFFD        aij = (MatMFFD)mat->data;
487:   if (mode == INSERT_VALUES) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"No diagonal set with INSERT_VALUES");
488:   if (!aij->dshift) {
489:     VecDuplicate(ll,&aij->dshift);
490:   }
491:   VecAXPY(aij->dshift,1.0,ll);
492:   return(0);
493: }
497: PetscErrorCode MatShift_MFFD(Mat Y,PetscScalar a)
498: {
499:   MatMFFD shell = (MatMFFD)Y->data;
502:   shell->vshift += a;
503:   return(0);
504: }
508: PetscErrorCode MatScale_MFFD(Mat Y,PetscScalar a)
509: {
510:   MatMFFD shell = (MatMFFD)Y->data;
513:   shell->vscale *= a;
514:   return(0);
515: }
519: PETSC_EXTERN PetscErrorCode MatMFFDSetBase_MFFD(Mat J,Vec U,Vec F)
520: {
522:   MatMFFD        ctx = (MatMFFD)J->data;
525:   MatMFFDResetHHistory(J);
527:   ctx->current_u = U;
528:   if (F) {
529:     if (ctx->current_f_allocated) {VecDestroy(&ctx->current_f);}
530:     ctx->current_f           = F;
531:     ctx->current_f_allocated = PETSC_FALSE;
532:   } else if (!ctx->current_f_allocated) {
533:     MatCreateVecs(J,NULL,&ctx->current_f);
535:     ctx->current_f_allocated = PETSC_TRUE;
536:   }
537:   if (!ctx->w) {
538:     VecDuplicate(ctx->current_u, &ctx->w);
539:   }
540:   J->assembled = PETSC_TRUE;
541:   return(0);
542: }
544: typedef PetscErrorCode (*FCN3)(void*,Vec,Vec,PetscScalar*); /* force argument to next function to not be extern C*/
548: PetscErrorCode  MatMFFDSetCheckh_MFFD(Mat J,FCN3 fun,void *ectx)
549: {
550:   MatMFFD ctx = (MatMFFD)J->data;
553:   ctx->checkh    = fun;
554:   ctx->checkhctx = ectx;
555:   return(0);
556: }
560: /*@C
561:    MatMFFDSetOptionsPrefix - Sets the prefix used for searching for all
562:    MatMFFD options in the database.
564:    Collective on Mat
566:    Input Parameter:
567: +  A - the Mat context
568: -  prefix - the prefix to prepend to all option names
570:    Notes:
571:    A hyphen (-) must NOT be given at the beginning of the prefix name.
572:    The first character of all runtime options is AUTOMATICALLY the hyphen.
574:    Level: advanced
576: .keywords: SNES, matrix-free, parameters
578: .seealso: MatSetFromOptions(), MatCreateSNESMF()
579: @*/
580: PetscErrorCode  MatMFFDSetOptionsPrefix(Mat mat,const char prefix[])
582: {
583:   MatMFFD        mfctx = mat ? (MatMFFD)mat->data : (MatMFFD)NULL;
589:   PetscObjectSetOptionsPrefix((PetscObject)mfctx,prefix);
590:   return(0);
591: }
595: PetscErrorCode  MatSetFromOptions_MFFD(PetscOptions *PetscOptionsObject,Mat mat)
596: {
597:   MatMFFD        mfctx = (MatMFFD)mat->data;
599:   PetscBool      flg;
600:   char           ftype[256];
605:   PetscObjectOptionsBegin((PetscObject)mfctx);
606:   PetscOptionsFList("-mat_mffd_type","Matrix free type","MatMFFDSetType",MatMFFDList,((PetscObject)mfctx)->type_name,ftype,256,&flg);
607:   if (flg) {
608:     MatMFFDSetType(mat,ftype);
609:   }
611:   PetscOptionsReal("-mat_mffd_err","set sqrt relative error in function","MatMFFDSetFunctionError",mfctx->error_rel,&mfctx->error_rel,0);
612:   PetscOptionsInt("-mat_mffd_period","how often h is recomputed","MatMFFDSetPeriod",mfctx->recomputeperiod,&mfctx->recomputeperiod,0);
614:   flg  = PETSC_FALSE;
615:   PetscOptionsBool("-mat_mffd_check_positivity","Insure that U + h*a is nonnegative","MatMFFDSetCheckh",flg,&flg,NULL);
616:   if (flg) {
617:     MatMFFDSetCheckh(mat,MatMFFDCheckPositivity,0);
618:   }
619:   if (mfctx->ops->setfromoptions) {
620:     (*mfctx->ops->setfromoptions)(PetscOptionsObject,mfctx);
621:   }
622:   PetscOptionsEnd();
623:   return(0);
624: }
628: PetscErrorCode  MatMFFDSetPeriod_MFFD(Mat mat,PetscInt period)
629: {
630:   MatMFFD ctx = (MatMFFD)mat->data;
634:   ctx->recomputeperiod = period;
635:   return(0);
636: }
640: PetscErrorCode  MatMFFDSetFunction_MFFD(Mat mat,PetscErrorCode (*func)(void*,Vec,Vec),void *funcctx)
641: {
642:   MatMFFD ctx = (MatMFFD)mat->data;
645:   ctx->func    = func;
646:   ctx->funcctx = funcctx;
647:   return(0);
648: }
652: PetscErrorCode  MatMFFDSetFunctionError_MFFD(Mat mat,PetscReal error)
653: {
654:   MatMFFD ctx = (MatMFFD)mat->data;
658:   if (error != PETSC_DEFAULT) ctx->error_rel = error;
659:   return(0);
660: }
662: /*MC
663:   MATMFFD - MATMFFD = "mffd" - A matrix free matrix type.
665:   Level: advanced
667: .seealso: MatCreateMFFD(), MatCreateSNESMF(), MatMFFDSetFunction()
668: M*/
671: PETSC_EXTERN PetscErrorCode MatCreate_MFFD(Mat A)
672: {
673:   MatMFFD        mfctx;
677:   MatMFFDInitializePackage();
679:   PetscHeaderCreate(mfctx,MATMFFD_CLASSID,"MatMFFD","Matrix-free Finite Differencing","Mat",PetscObjectComm((PetscObject)A),MatDestroy_MFFD,MatView_MFFD);
681:   mfctx->error_rel                = PETSC_SQRT_MACHINE_EPSILON;
682:   mfctx->recomputeperiod          = 1;
683:   mfctx->count                    = 0;
684:   mfctx->currenth                 = 0.0;
685:   mfctx->historyh                 = NULL;
686:   mfctx->ncurrenth                = 0;
687:   mfctx->maxcurrenth              = 0;
688:   ((PetscObject)mfctx)->type_name = 0;
690:   mfctx->vshift = 0.0;
691:   mfctx->vscale = 1.0;
693:   /*
694:      Create the empty data structure to contain compute-h routines.
695:      These will be filled in below from the command line options or
696:      a later call with MatMFFDSetType() or if that is not called
697:      then it will default in the first use of MatMult_MFFD()
698:   */
699:   mfctx->ops->compute        = 0;
700:   mfctx->ops->destroy        = 0;
701:   mfctx->ops->view           = 0;
702:   mfctx->ops->setfromoptions = 0;
703:   mfctx->hctx                = 0;
705:   mfctx->func    = 0;
706:   mfctx->funcctx = 0;
707:   mfctx->w       = NULL;
709:   A->data = mfctx;
711:   A->ops->mult           = MatMult_MFFD;
712:   A->ops->destroy        = MatDestroy_MFFD;
713:   A->ops->view           = MatView_MFFD;
714:   A->ops->assemblyend    = MatAssemblyEnd_MFFD;
715:   A->ops->getdiagonal    = MatGetDiagonal_MFFD;
716:   A->ops->scale          = MatScale_MFFD;
717:   A->ops->shift          = MatShift_MFFD;
718:   A->ops->diagonalscale  = MatDiagonalScale_MFFD;
719:   A->ops->diagonalset    = MatDiagonalSet_MFFD;
720:   A->ops->setfromoptions = MatSetFromOptions_MFFD;
721:   A->assembled           = PETSC_TRUE;
723:   PetscLayoutSetUp(A->rmap);
724:   PetscLayoutSetUp(A->cmap);
726:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetBase_C",MatMFFDSetBase_MFFD);
727:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctioniBase_C",MatMFFDSetFunctioniBase_MFFD);
728:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctioni_C",MatMFFDSetFunctioni_MFFD);
729:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunction_C",MatMFFDSetFunction_MFFD);
730:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetCheckh_C",MatMFFDSetCheckh_MFFD);
731:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetPeriod_C",MatMFFDSetPeriod_MFFD);
732:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctionError_C",MatMFFDSetFunctionError_MFFD);
733:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDResetHHistory_C",MatMFFDResetHHistory_MFFD);
735:   mfctx->mat = A;
737:   PetscObjectChangeTypeName((PetscObject)A,MATMFFD);
738:   return(0);
739: }
743: /*@
744:    MatCreateMFFD - Creates a matrix-free matrix. See also MatCreateSNESMF()
746:    Collective on Vec
748:    Input Parameters:
749: +  comm - MPI communicator
750: .  m - number of local rows (or PETSC_DECIDE to have calculated if M is given)
751:            This value should be the same as the local size used in creating the
752:            y vector for the matrix-vector product y = Ax.
753: .  n - This value should be the same as the local size used in creating the
754:        x vector for the matrix-vector product y = Ax. (or PETSC_DECIDE to have
755:        calculated if N is given) For square matrices n is almost always m.
756: .  M - number of global rows (or PETSC_DETERMINE to have calculated if m is given)
757: -  N - number of global columns (or PETSC_DETERMINE to have calculated if n is given)
760:    Output Parameter:
761: .  J - the matrix-free matrix
763:    Options Database Keys: call MatSetFromOptions() to trigger these
764: +  -mat_mffd_type - wp or ds (see MATMFFD_WP or MATMFFD_DS)
765: -  -mat_mffd_err - square root of estimated relative error in function evaluation
766: -  -mat_mffd_period - how often h is recomputed, defaults to 1, everytime
769:    Level: advanced
771:    Notes:
772:    The matrix-free matrix context merely contains the function pointers
773:    and work space for performing finite difference approximations of
774:    Jacobian-vector products, F'(u)*a,
776:    The default code uses the following approach to compute h
778: .vb
779:      F'(u)*a = [F(u+h*a) - F(u)]/h where
780:      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
781:        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   otherwise
782:  where
783:      error_rel = square root of relative error in function evaluation
784:      umin = minimum iterate parameter
785: .ve
787:    You can call SNESSetJacobian() with MatMFFDComputeJacobian() if you are using matrix and not a different
788:    preconditioner matrix
790:    The user can set the error_rel via MatMFFDSetFunctionError() and
791:    umin via MatMFFDDSSetUmin(); see Users-Manual: ch_snes for details.
793:    The user should call MatDestroy() when finished with the matrix-free
794:    matrix context.
796:    Options Database Keys:
797: +  -mat_mffd_err <error_rel> - Sets error_rel
798: .  -mat_mffd_unim <umin> - Sets umin (for default PETSc routine that computes h only)
799: -  -mat_mffd_check_positivity
801: .keywords: default, matrix-free, create, matrix
803: .seealso: MatDestroy(), MatMFFDSetFunctionError(), MatMFFDDSSetUmin(), MatMFFDSetFunction()
804:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), MatCreateSNESMF(),
805:           MatMFFDGetH(), MatMFFDRegister(), MatMFFDComputeJacobian()
807: @*/
808: PetscErrorCode  MatCreateMFFD(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,Mat *J)
809: {
813:   MatCreate(comm,J);
814:   MatSetSizes(*J,m,n,M,N);
815:   MatSetType(*J,MATMFFD);
816:   MatSetUp(*J);
817:   return(0);
818: }
823: /*@
824:    MatMFFDGetH - Gets the last value that was used as the differencing
825:    parameter.
827:    Not Collective
829:    Input Parameters:
830: .  mat - the matrix obtained with MatCreateSNESMF()
832:    Output Paramter:
833: .  h - the differencing step size
835:    Level: advanced
837: .keywords: SNES, matrix-free, parameters
839: .seealso: MatCreateSNESMF(),MatMFFDSetHHistory(), MatCreateMFFD(), MATMFFD, MatMFFDResetHHistory()
840: @*/
841: PetscErrorCode  MatMFFDGetH(Mat mat,PetscScalar *h)
842: {
843:   MatMFFD        ctx = (MatMFFD)mat->data;
845:   PetscBool      match;
848:   PetscObjectTypeCompare((PetscObject)mat,MATMFFD,&match);
849:   if (!match) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Not a MFFD matrix");
851:   *h = ctx->currenth;
852:   return(0);
853: }
857: /*@C
858:    MatMFFDSetFunction - Sets the function used in applying the matrix free.
860:    Logically Collective on Mat
862:    Input Parameters:
863: +  mat - the matrix free matrix created via MatCreateSNESMF() or MatCreateMFFD()
864: .  func - the function to use
865: -  funcctx - optional function context passed to function
867:    Calling Sequence of func:
868: $     func (void *funcctx, Vec x, Vec f)
870: +  funcctx - user provided context
871: .  x - input vector
872: -  f - computed output function
874:    Level: advanced
876:    Notes:
877:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
878:     matrix inside your compute Jacobian routine
880:     If this is not set then it will use the function set with SNESSetFunction() if MatCreateSNESMF() was used.
882: .keywords: SNES, matrix-free, function
884: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD,
885:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()
886: @*/
887: PetscErrorCode  MatMFFDSetFunction(Mat mat,PetscErrorCode (*func)(void*,Vec,Vec),void *funcctx)
888: {
892:   PetscTryMethod(mat,"MatMFFDSetFunction_C",(Mat,PetscErrorCode (*)(void*,Vec,Vec),void*),(mat,func,funcctx));
893:   return(0);
894: }
898: /*@C
899:    MatMFFDSetFunctioni - Sets the function for a single component
901:    Logically Collective on Mat
903:    Input Parameters:
904: +  mat - the matrix free matrix created via MatCreateSNESMF()
905: -  funci - the function to use
907:    Level: advanced
909:    Notes:
910:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
911:     matrix inside your compute Jacobian routine
914: .keywords: SNES, matrix-free, function
916: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()
918: @*/
919: PetscErrorCode  MatMFFDSetFunctioni(Mat mat,PetscErrorCode (*funci)(void*,PetscInt,Vec,PetscScalar*))
920: {
925:   PetscTryMethod(mat,"MatMFFDSetFunctioni_C",(Mat,PetscErrorCode (*)(void*,PetscInt,Vec,PetscScalar*)),(mat,funci));
926:   return(0);
927: }
932: /*@C
933:    MatMFFDSetFunctioniBase - Sets the base vector for a single component function evaluation
935:    Logically Collective on Mat
937:    Input Parameters:
938: +  mat - the matrix free matrix created via MatCreateSNESMF()
939: -  func - the function to use
941:    Level: advanced
943:    Notes:
944:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
945:     matrix inside your compute Jacobian routine
948: .keywords: SNES, matrix-free, function
950: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD
951:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()
952: @*/
953: PetscErrorCode  MatMFFDSetFunctioniBase(Mat mat,PetscErrorCode (*func)(void*,Vec))
954: {
959:   PetscTryMethod(mat,"MatMFFDSetFunctioniBase_C",(Mat,PetscErrorCode (*)(void*,Vec)),(mat,func));
960:   return(0);
961: }
965: /*@
966:    MatMFFDSetPeriod - Sets how often h is recomputed, by default it is everytime
968:    Logically Collective on Mat
970:    Input Parameters:
971: +  mat - the matrix free matrix created via MatCreateSNESMF()
972: -  period - 1 for everytime, 2 for every second etc
974:    Options Database Keys:
975: +  -mat_mffd_period <period>
977:    Level: advanced
980: .keywords: SNES, matrix-free, parameters
982: .seealso: MatCreateSNESMF(),MatMFFDGetH(),
983:           MatMFFDSetHHistory(), MatMFFDResetHHistory()
984: @*/
985: PetscErrorCode  MatMFFDSetPeriod(Mat mat,PetscInt period)
986: {
990:   PetscTryMethod(mat,"MatMFFDSetPeriod_C",(Mat,PetscInt),(mat,period));
991:   return(0);
992: }
996: /*@
997:    MatMFFDSetFunctionError - Sets the error_rel for the approximation of
998:    matrix-vector products using finite differences.
1000:    Logically Collective on Mat
1002:    Input Parameters:
1003: +  mat - the matrix free matrix created via MatCreateMFFD() or MatCreateSNESMF()
1004: -  error_rel - relative error (should be set to the square root of
1005:                the relative error in the function evaluations)
1007:    Options Database Keys:
1008: +  -mat_mffd_err <error_rel> - Sets error_rel
1010:    Level: advanced
1012:    Notes:
1013:    The default matrix-free matrix-vector product routine computes
1014: .vb
1015:      F'(u)*a = [F(u+h*a) - F(u)]/h where
1016:      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
1017:        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   else
1018: .ve
1020: .keywords: SNES, matrix-free, parameters
1022: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD
1023:           MatMFFDSetHHistory(), MatMFFDResetHHistory()
1024: @*/
1025: PetscErrorCode  MatMFFDSetFunctionError(Mat mat,PetscReal error)
1026: {
1030:   PetscTryMethod(mat,"MatMFFDSetFunctionError_C",(Mat,PetscReal),(mat,error));
1031:   return(0);
1032: }
1036: /*@
1037:    MatMFFDSetHHistory - Sets an array to collect a history of the
1038:    differencing values (h) computed for the matrix-free product.
1040:    Logically Collective on Mat
1042:    Input Parameters:
1043: +  J - the matrix-free matrix context
1044: .  histroy - space to hold the history
1045: -  nhistory - number of entries in history, if more entries are generated than
1046:               nhistory, then the later ones are discarded
1048:    Level: advanced
1050:    Notes:
1051:    Use MatMFFDResetHHistory() to reset the history counter and collect
1052:    a new batch of differencing parameters, h.
1054: .keywords: SNES, matrix-free, h history, differencing history
1056: .seealso: MatMFFDGetH(), MatCreateSNESMF(),
1057:           MatMFFDResetHHistory(), MatMFFDSetFunctionError()
1059: @*/
1060: PetscErrorCode  MatMFFDSetHHistory(Mat J,PetscScalar history[],PetscInt nhistory)
1061: {
1062:   MatMFFD        ctx = (MatMFFD)J->data;
1064:   PetscBool      match;
1067:   PetscObjectTypeCompare((PetscObject)J,MATMFFD,&match);
1068:   if (!match) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONG,"Not a MFFD matrix");
1069:   ctx->historyh    = history;
1070:   ctx->maxcurrenth = nhistory;
1071:   ctx->currenth    = 0.;
1072:   return(0);
1073: }
1078: /*@
1079:    MatMFFDResetHHistory - Resets the counter to zero to begin
1080:    collecting a new set of differencing histories.
1082:    Logically Collective on Mat
1084:    Input Parameters:
1085: .  J - the matrix-free matrix context
1087:    Level: advanced
1089:    Notes:
1090:    Use MatMFFDSetHHistory() to create the original history counter.
1092: .keywords: SNES, matrix-free, h history, differencing history
1094: .seealso: MatMFFDGetH(), MatCreateSNESMF(),
1095:           MatMFFDSetHHistory(), MatMFFDSetFunctionError()
1097: @*/
1098: PetscErrorCode  MatMFFDResetHHistory(Mat J)
1099: {
1103:   PetscTryMethod(J,"MatMFFDResetHHistory_C",(Mat),(J));
1104:   return(0);
1105: }
1110: /*@
1111:     MatMFFDSetBase - Sets the vector U at which matrix vector products of the
1112:         Jacobian are computed
1114:     Logically Collective on Mat
1116:     Input Parameters:
1117: +   J - the MatMFFD matrix
1118: .   U - the vector
1119: -   F - (optional) vector that contains F(u) if it has been already computed
1121:     Notes: This is rarely used directly
1123:     If F is provided then it is not recomputed. Otherwise the function is evaluated at the base
1124:     point during the first MatMult() after each call to MatMFFDSetBase().
1126:     Level: advanced
1128: @*/
1129: PetscErrorCode  MatMFFDSetBase(Mat J,Vec U,Vec F)
1130: {
1137:   PetscTryMethod(J,"MatMFFDSetBase_C",(Mat,Vec,Vec),(J,U,F));
1138:   return(0);
1139: }
1143: /*@C
1144:     MatMFFDSetCheckh - Sets a function that checks the computed h and adjusts
1145:         it to satisfy some criteria
1147:     Logically Collective on Mat
1149:     Input Parameters:
1150: +   J - the MatMFFD matrix
1151: .   fun - the function that checks h
1152: -   ctx - any context needed by the function
1154:     Options Database Keys:
1155: .   -mat_mffd_check_positivity
1157:     Level: advanced
1159:     Notes: For example, MatMFFDSetCheckPositivity() insures that all entries
1160:        of U + h*a are non-negative
1162: .seealso:  MatMFFDSetCheckPositivity()
1163: @*/
1164: PetscErrorCode  MatMFFDSetCheckh(Mat J,PetscErrorCode (*fun)(void*,Vec,Vec,PetscScalar*),void *ctx)
1165: {
1170:   PetscTryMethod(J,"MatMFFDSetCheckh_C",(Mat,PetscErrorCode (*)(void*,Vec,Vec,PetscScalar*),void*),(J,fun,ctx));
1171:   return(0);
1172: }
1176: /*@
1177:     MatMFFDCheckPositivity - Checks that all entries in U + h*a are positive or
1178:         zero, decreases h until this is satisfied.
1180:     Logically Collective on Vec
1182:     Input Parameters:
1183: +   U - base vector that is added to
1184: .   a - vector that is added
1185: .   h - scaling factor on a
1186: -   dummy - context variable (unused)
1188:     Options Database Keys:
1189: .   -mat_mffd_check_positivity
1191:     Level: advanced
1193:     Notes: This is rarely used directly, rather it is passed as an argument to
1194:            MatMFFDSetCheckh()
1196: .seealso:  MatMFFDSetCheckh()
1197: @*/
1198: PetscErrorCode  MatMFFDCheckPositivity(void *dummy,Vec U,Vec a,PetscScalar *h)
1199: {
1200:   PetscReal      val, minval;
1201:   PetscScalar    *u_vec, *a_vec;
1203:   PetscInt       i,n;
1204:   MPI_Comm       comm;
1207:   PetscObjectGetComm((PetscObject)U,&comm);
1208:   VecGetArray(U,&u_vec);
1209:   VecGetArray(a,&a_vec);
1210:   VecGetLocalSize(U,&n);
1211:   minval = PetscAbsScalar(*h*1.01);
1212:   for (i=0; i<n; i++) {
1213:     if (PetscRealPart(u_vec[i] + *h*a_vec[i]) <= 0.0) {
1214:       val = PetscAbsScalar(u_vec[i]/a_vec[i]);
1215:       if (val < minval) minval = val;
1216:     }
1217:   }
1218:   VecRestoreArray(U,&u_vec);
1219:   VecRestoreArray(a,&a_vec);
1220:   MPI_Allreduce(&minval,&val,1,MPIU_REAL,MPIU_MIN,comm);
1221:   if (val <= PetscAbsScalar(*h)) {
1222:     PetscInfo2(U,"Scaling back h from %g to %g\n",(double)PetscRealPart(*h),(double)(.99*val));
1223:     if (PetscRealPart(*h) > 0.0) *h =  0.99*val;
1224:     else                         *h = -0.99*val;
1225:   }
1226:   return(0);
1227: }