Date: 2013-07-02T14:43:45+00:00

Actual source code: mffd.c
petsc-3.4.2 2013-07-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: $     -snes_mf_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: }

    211: PetscErrorCode  MatMFFDAddNullSpace_MFFD(Mat J,MatNullSpace nullsp)
    212: {
    214:   MatMFFD        ctx = (MatMFFD)J->data;

    217:   PetscObjectReference((PetscObject)nullsp);
    218:   if (ctx->sp) { MatNullSpaceDestroy(&ctx->sp); }
    219:   ctx->sp = nullsp;
    220:   return(0);
    221: }

    223: /* ----------------------------------------------------------------------------------------*/
    226: PetscErrorCode MatDestroy_MFFD(Mat mat)
    227: {
    229:   MatMFFD        ctx = (MatMFFD)mat->data;

    232:   VecDestroy(&ctx->w);
    233:   VecDestroy(&ctx->drscale);
    234:   VecDestroy(&ctx->dlscale);
    235:   VecDestroy(&ctx->dshift);
    236:   if (ctx->current_f_allocated) {
    237:     VecDestroy(&ctx->current_f);
    238:   }
    239:   if (ctx->ops->destroy) {(*ctx->ops->destroy)(ctx);}
    240:   MatNullSpaceDestroy(&ctx->sp);
    241:   PetscHeaderDestroy(&ctx);
    242:   mat->data = 0;

    244:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetBase_C",NULL);
    245:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctioniBase_C",NULL);
    246:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctioni_C",NULL);
    247:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunction_C",NULL);
    248:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetFunctionError_C",NULL);
    249:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetCheckh_C",NULL);
    250:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDSetPeriod_C",NULL);
    251:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDResetHHistory_C",NULL);
    252:   PetscObjectComposeFunction((PetscObject)mat,"MatMFFDAddNullSpace_C",NULL);
    253:   return(0);
    254: }

    258: /*
    259:    MatMFFDView_MFFD - Views matrix-free parameters.

    261: */
    262: PetscErrorCode MatView_MFFD(Mat J,PetscViewer viewer)
    263: {
    265:   MatMFFD        ctx = (MatMFFD)J->data;
    266:   PetscBool      iascii, viewbase, viewfunction;
    267:   const char     *prefix;

    270:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
    271:   if (iascii) {
    272:     PetscViewerASCIIPrintf(viewer,"Matrix-free approximation:\n");
    273:     PetscViewerASCIIPushTab(viewer);
    274:     PetscViewerASCIIPrintf(viewer,"err=%G (relative error in function evaluation)\n",ctx->error_rel);
    275:     if (!((PetscObject)ctx)->type_name) {
    276:       PetscViewerASCIIPrintf(viewer,"The compute h routine has not yet been set\n");
    277:     } else {
    278:       PetscViewerASCIIPrintf(viewer,"Using %s compute h routine\n",((PetscObject)ctx)->type_name);
    279:     }
    280:     if (ctx->ops->view) {
    281:       (*ctx->ops->view)(ctx,viewer);
    282:     }
    283:     PetscObjectGetOptionsPrefix((PetscObject)J, &prefix);

    285:     PetscOptionsHasName(prefix, "-mat_mffd_view_base", &viewbase);
    286:     if (viewbase) {
    287:       PetscViewerASCIIPrintf(viewer, "Base:\n");
    288:       VecView(ctx->current_u, viewer);
    289:     }
    290:     PetscOptionsHasName(prefix, "-mat_mffd_view_function", &viewfunction);
    291:     if (viewfunction) {
    292:       PetscViewerASCIIPrintf(viewer, "Function:\n");
    293:       VecView(ctx->current_f, viewer);
    294:     }
    295:     PetscViewerASCIIPopTab(viewer);
    296:   }
    297:   return(0);
    298: }

    302: /*
    303:    MatAssemblyEnd_MFFD - Resets the ctx->ncurrenth to zero. This
    304:    allows the user to indicate the beginning of a new linear solve by calling
    305:    MatAssemblyXXX() on the matrix free matrix. This then allows the
    306:    MatCreateMFFD_WP() to properly compute ||U|| only the first time
    307:    in the linear solver rather than every time.

    309:    This function is referenced directly from MatAssemblyEnd_SNESMF(), which may be in a different shared library.
    310: */
    311: PETSC_EXTERN PetscErrorCode MatAssemblyEnd_MFFD(Mat J,MatAssemblyType mt)
    312: {
    314:   MatMFFD        j = (MatMFFD)J->data;

    317:   MatMFFDResetHHistory(J);
    318:   j->vshift = 0.0;
    319:   j->vscale = 1.0;
    320:   return(0);
    321: }

    325: /*
    326:   MatMult_MFFD - Default matrix-free form for Jacobian-vector product, y = F'(u)*a:

    328:         y ~= (F(u + ha) - F(u))/h,
    329:   where F = nonlinear function, as set by SNESSetFunction()
    330:         u = current iterate
    331:         h = difference interval
    332: */
    333: PetscErrorCode MatMult_MFFD(Mat mat,Vec a,Vec y)
    334: {
    335:   MatMFFD        ctx = (MatMFFD)mat->data;
    336:   PetscScalar    h;
    337:   Vec            w,U,F;
    339:   PetscBool      zeroa;

    342:   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");
    343:   /* We log matrix-free matrix-vector products separately, so that we can
    344:      separate the performance monitoring from the cases that use conventional
    345:      storage.  We may eventually modify event logging to associate events
    346:      with particular objects, hence alleviating the more general problem. */
    347:   PetscLogEventBegin(MATMFFD_Mult,a,y,0,0);

    349:   w = ctx->w;
    350:   U = ctx->current_u;
    351:   F = ctx->current_f;
    352:   /*
    353:       Compute differencing parameter
    354:   */
    355:   if (!ctx->ops->compute) {
    356:     MatMFFDSetType(mat,MATMFFD_WP);
    357:     MatSetFromOptions(mat);
    358:   }
    359:   (*ctx->ops->compute)(ctx,U,a,&h,&zeroa);
    360:   if (zeroa) {
    361:     VecSet(y,0.0);
    362:     return(0);
    363:   }

    365:   if (PetscIsInfOrNanScalar(h)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed Nan differencing parameter h");
    366:   if (ctx->checkh) {
    367:     (*ctx->checkh)(ctx->checkhctx,U,a,&h);
    368:   }

    370:   /* keep a record of the current differencing parameter h */
    371:   ctx->currenth = h;
    372: #if defined(PETSC_USE_COMPLEX)
    373:   PetscInfo2(mat,"Current differencing parameter: %G + %G i\n",PetscRealPart(h),PetscImaginaryPart(h));
    374: #else
    375:   PetscInfo1(mat,"Current differencing parameter: %15.12e\n",h);
    376: #endif
    377:   if (ctx->historyh && ctx->ncurrenth < ctx->maxcurrenth) {
    378:     ctx->historyh[ctx->ncurrenth] = h;
    379:   }
    380:   ctx->ncurrenth++;

    382:   /* w = u + ha */
    383:   if (ctx->drscale) {
    384:     VecPointwiseMult(ctx->drscale,a,U);
    385:     VecAYPX(U,h,w);
    386:   } else {
    387:     VecWAXPY(w,h,a,U);
    388:   }

    390:   /* compute func(U) as base for differencing; only needed first time in and not when provided by user */
    391:   if (ctx->ncurrenth == 1 && ctx->current_f_allocated) {
    392:     (*ctx->func)(ctx->funcctx,U,F);
    393:   }
    394:   (*ctx->func)(ctx->funcctx,w,y);

    396:   VecAXPY(y,-1.0,F);
    397:   VecScale(y,1.0/h);

    399:   if ((ctx->vshift != 0.0) || (ctx->vscale != 1.0)) {
    400:     VecAXPBY(y,ctx->vshift,ctx->vscale,a);
    401:   }
    402:   if (ctx->dlscale) {
    403:     VecPointwiseMult(y,ctx->dlscale,y);
    404:   }
    405:   if (ctx->dshift) {
    406:     VecPointwiseMult(ctx->dshift,a,U);
    407:     VecAXPY(y,1.0,U);
    408:   }

    410:   if (ctx->sp) {MatNullSpaceRemove(ctx->sp,y,NULL);}

    412:   PetscLogEventEnd(MATMFFD_Mult,a,y,0,0);
    413:   return(0);
    414: }

    418: /*
    419:   MatGetDiagonal_MFFD - Gets the diagonal for a matrix free matrix

    421:         y ~= (F(u + ha) - F(u))/h,
    422:   where F = nonlinear function, as set by SNESSetFunction()
    423:         u = current iterate
    424:         h = difference interval
    425: */
    426: PetscErrorCode MatGetDiagonal_MFFD(Mat mat,Vec a)
    427: {
    428:   MatMFFD        ctx = (MatMFFD)mat->data;
    429:   PetscScalar    h,*aa,*ww,v;
    430:   PetscReal      epsilon = PETSC_SQRT_MACHINE_EPSILON,umin = 100.0*PETSC_SQRT_MACHINE_EPSILON;
    431:   Vec            w,U;
    433:   PetscInt       i,rstart,rend;

    436:   if (!ctx->funci) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Requires calling MatMFFDSetFunctioni() first");

    438:   w    = ctx->w;
    439:   U    = ctx->current_u;
    440:   (*ctx->func)(ctx->funcctx,U,a);
    441:   (*ctx->funcisetbase)(ctx->funcctx,U);
    442:   VecCopy(U,w);

    444:   VecGetOwnershipRange(a,&rstart,&rend);
    445:   VecGetArray(a,&aa);
    446:   for (i=rstart; i<rend; i++) {
    447:     VecGetArray(w,&ww);
    448:     h    = ww[i-rstart];
    449:     if (h == 0.0) h = 1.0;
    450:     if (PetscAbsScalar(h) < umin && PetscRealPart(h) >= 0.0)     h = umin;
    451:     else if (PetscRealPart(h) < 0.0 && PetscAbsScalar(h) < umin) h = -umin;
    452:     h *= epsilon;

    454:     ww[i-rstart] += h;
    455:     VecRestoreArray(w,&ww);
    456:     (*ctx->funci)(ctx->funcctx,i,w,&v);
    457:     aa[i-rstart]  = (v - aa[i-rstart])/h;

    459:     /* possibly shift and scale result */
    460:     if ((ctx->vshift != 0.0) || (ctx->vscale != 1.0)) {
    461:       aa[i - rstart] = ctx->vshift + ctx->vscale*aa[i-rstart];
    462:     }

    464:     VecGetArray(w,&ww);
    465:     ww[i-rstart] -= h;
    466:     VecRestoreArray(w,&ww);
    467:   }
    468:   VecRestoreArray(a,&aa);
    469:   return(0);
    470: }

    474: PetscErrorCode MatDiagonalScale_MFFD(Mat mat,Vec ll,Vec rr)
    475: {
    476:   MatMFFD        aij = (MatMFFD)mat->data;

    480:   if (ll && !aij->dlscale) {
    481:     VecDuplicate(ll,&aij->dlscale);
    482:   }
    483:   if (rr && !aij->drscale) {
    484:     VecDuplicate(rr,&aij->drscale);
    485:   }
    486:   if (ll) {
    487:     VecCopy(ll,aij->dlscale);
    488:   }
    489:   if (rr) {
    490:     VecCopy(rr,aij->drscale);
    491:   }
    492:   return(0);
    493: }

    497: PetscErrorCode MatDiagonalSet_MFFD(Mat mat,Vec ll,InsertMode mode)
    498: {
    499:   MatMFFD        aij = (MatMFFD)mat->data;

    503:   if (mode == INSERT_VALUES) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"No diagonal set with INSERT_VALUES");
    504:   if (!aij->dshift) {
    505:     VecDuplicate(ll,&aij->dshift);
    506:   }
    507:   VecAXPY(aij->dshift,1.0,ll);
    508:   return(0);
    509: }

    513: PetscErrorCode MatShift_MFFD(Mat Y,PetscScalar a)
    514: {
    515:   MatMFFD shell = (MatMFFD)Y->data;

    518:   shell->vshift += a;
    519:   return(0);
    520: }

    524: PetscErrorCode MatScale_MFFD(Mat Y,PetscScalar a)
    525: {
    526:   MatMFFD shell = (MatMFFD)Y->data;

    529:   shell->vscale *= a;
    530:   return(0);
    531: }

    535: PETSC_EXTERN PetscErrorCode MatMFFDSetBase_MFFD(Mat J,Vec U,Vec F)
    536: {
    538:   MatMFFD        ctx = (MatMFFD)J->data;

    541:   MatMFFDResetHHistory(J);

    543:   ctx->current_u = U;
    544:   if (F) {
    545:     if (ctx->current_f_allocated) {VecDestroy(&ctx->current_f);}
    546:     ctx->current_f           = F;
    547:     ctx->current_f_allocated = PETSC_FALSE;
    548:   } else if (!ctx->current_f_allocated) {
    549:     VecDuplicate(ctx->current_u, &ctx->current_f);

    551:     ctx->current_f_allocated = PETSC_TRUE;
    552:   }
    553:   if (!ctx->w) {
    554:     VecDuplicate(ctx->current_u, &ctx->w);
    555:   }
    556:   J->assembled = PETSC_TRUE;
    557:   return(0);
    558: }

    560: typedef PetscErrorCode (*FCN3)(void*,Vec,Vec,PetscScalar*); /* force argument to next function to not be extern C*/

    564: PetscErrorCode  MatMFFDSetCheckh_MFFD(Mat J,FCN3 fun,void *ectx)
    565: {
    566:   MatMFFD ctx = (MatMFFD)J->data;

    569:   ctx->checkh    = fun;
    570:   ctx->checkhctx = ectx;
    571:   return(0);
    572: }

    576: /*@C
    577:    MatMFFDSetOptionsPrefix - Sets the prefix used for searching for all
    578:    MatMFFD options in the database.

    580:    Collective on Mat

    582:    Input Parameter:
    583: +  A - the Mat context
    584: -  prefix - the prefix to prepend to all option names

    586:    Notes:
    587:    A hyphen (-) must NOT be given at the beginning of the prefix name.
    588:    The first character of all runtime options is AUTOMATICALLY the hyphen.

    590:    Level: advanced

    592: .keywords: SNES, matrix-free, parameters

    594: .seealso: MatSetFromOptions(), MatCreateSNESMF()
    595: @*/
    596: PetscErrorCode  MatMFFDSetOptionsPrefix(Mat mat,const char prefix[])

    598: {
    599:   MatMFFD        mfctx = mat ? (MatMFFD)mat->data : (MatMFFD)NULL;

    605:   PetscObjectSetOptionsPrefix((PetscObject)mfctx,prefix);
    606:   return(0);
    607: }

    611: PetscErrorCode  MatSetFromOptions_MFFD(Mat mat)
    612: {
    613:   MatMFFD        mfctx = (MatMFFD)mat->data;
    615:   PetscBool      flg;
    616:   char           ftype[256];

    621:   PetscObjectOptionsBegin((PetscObject)mfctx);
    622:   PetscOptionsList("-mat_mffd_type","Matrix free type","MatMFFDSetType",MatMFFDList,((PetscObject)mfctx)->type_name,ftype,256,&flg);
    623:   if (flg) {
    624:     MatMFFDSetType(mat,ftype);
    625:   }

    627:   PetscOptionsReal("-mat_mffd_err","set sqrt relative error in function","MatMFFDSetFunctionError",mfctx->error_rel,&mfctx->error_rel,0);
    628:   PetscOptionsInt("-mat_mffd_period","how often h is recomputed","MatMFFDSetPeriod",mfctx->recomputeperiod,&mfctx->recomputeperiod,0);

    630:   flg  = PETSC_FALSE;
    631:   PetscOptionsBool("-mat_mffd_check_positivity","Insure that U + h*a is nonnegative","MatMFFDSetCheckh",flg,&flg,NULL);
    632:   if (flg) {
    633:     MatMFFDSetCheckh(mat,MatMFFDCheckPositivity,0);
    634:   }
    635:   if (mfctx->ops->setfromoptions) {
    636:     (*mfctx->ops->setfromoptions)(mfctx);
    637:   }
    638:   PetscOptionsEnd();
    639:   return(0);
    640: }

    644: PetscErrorCode  MatMFFDSetPeriod_MFFD(Mat mat,PetscInt period)
    645: {
    646:   MatMFFD ctx = (MatMFFD)mat->data;

    650:   ctx->recomputeperiod = period;
    651:   return(0);
    652: }

    656: PetscErrorCode  MatMFFDSetFunction_MFFD(Mat mat,PetscErrorCode (*func)(void*,Vec,Vec),void *funcctx)
    657: {
    658:   MatMFFD ctx = (MatMFFD)mat->data;

    661:   ctx->func    = func;
    662:   ctx->funcctx = funcctx;
    663:   return(0);
    664: }

    668: PetscErrorCode  MatMFFDSetFunctionError_MFFD(Mat mat,PetscReal error)
    669: {
    670:   MatMFFD ctx = (MatMFFD)mat->data;

    674:   if (error != PETSC_DEFAULT) ctx->error_rel = error;
    675:   return(0);
    676: }

    678: /*MC
    679:   MATMFFD - MATMFFD = "mffd" - A matrix free matrix type.

    681:   Level: advanced

    683: .seealso: MatCreateMFFD(), MatCreateSNESMF(), MatMFFDSetFunction()
    684: M*/
    687: PETSC_EXTERN PetscErrorCode MatCreate_MFFD(Mat A)
    688: {
    689:   MatMFFD        mfctx;

    693: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
    694:   MatMFFDInitializePackage();
    695: #endif

    697:   PetscHeaderCreate(mfctx,_p_MatMFFD,struct _MFOps,MATMFFD_CLASSID,"MatMFFD","Matrix-free Finite Differencing","Mat",PetscObjectComm((PetscObject)A),MatDestroy_MFFD,MatView_MFFD);

    699:   mfctx->sp                       = 0;
    700:   mfctx->error_rel                = PETSC_SQRT_MACHINE_EPSILON;
    701:   mfctx->recomputeperiod          = 1;
    702:   mfctx->count                    = 0;
    703:   mfctx->currenth                 = 0.0;
    704:   mfctx->historyh                 = NULL;
    705:   mfctx->ncurrenth                = 0;
    706:   mfctx->maxcurrenth              = 0;
    707:   ((PetscObject)mfctx)->type_name = 0;

    709:   mfctx->vshift = 0.0;
    710:   mfctx->vscale = 1.0;

    712:   /*
    713:      Create the empty data structure to contain compute-h routines.
    714:      These will be filled in below from the command line options or
    715:      a later call with MatMFFDSetType() or if that is not called
    716:      then it will default in the first use of MatMult_MFFD()
    717:   */
    718:   mfctx->ops->compute        = 0;
    719:   mfctx->ops->destroy        = 0;
    720:   mfctx->ops->view           = 0;
    721:   mfctx->ops->setfromoptions = 0;
    722:   mfctx->hctx                = 0;

    724:   mfctx->func    = 0;
    725:   mfctx->funcctx = 0;
    726:   mfctx->w       = NULL;

    728:   A->data = mfctx;

    730:   A->ops->mult           = MatMult_MFFD;
    731:   A->ops->destroy        = MatDestroy_MFFD;
    732:   A->ops->view           = MatView_MFFD;
    733:   A->ops->assemblyend    = MatAssemblyEnd_MFFD;
    734:   A->ops->getdiagonal    = MatGetDiagonal_MFFD;
    735:   A->ops->scale          = MatScale_MFFD;
    736:   A->ops->shift          = MatShift_MFFD;
    737:   A->ops->diagonalscale  = MatDiagonalScale_MFFD;
    738:   A->ops->diagonalset    = MatDiagonalSet_MFFD;
    739:   A->ops->setfromoptions = MatSetFromOptions_MFFD;
    740:   A->assembled           = PETSC_TRUE;

    742:   PetscLayoutSetUp(A->rmap);
    743:   PetscLayoutSetUp(A->cmap);

    745:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetBase_C",MatMFFDSetBase_MFFD);
    746:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctioniBase_C",MatMFFDSetFunctioniBase_MFFD);
    747:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctioni_C",MatMFFDSetFunctioni_MFFD);
    748:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunction_C",MatMFFDSetFunction_MFFD);
    749:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetCheckh_C",MatMFFDSetCheckh_MFFD);
    750:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetPeriod_C",MatMFFDSetPeriod_MFFD);
    751:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDSetFunctionError_C",MatMFFDSetFunctionError_MFFD);
    752:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDResetHHistory_C",MatMFFDResetHHistory_MFFD);
    753:   PetscObjectComposeFunction((PetscObject)A,"MatMFFDAddNullSpace_C",MatMFFDAddNullSpace_MFFD);

    755:   mfctx->mat = A;

    757:   PetscObjectChangeTypeName((PetscObject)A,MATMFFD);
    758:   return(0);
    759: }

    763: /*@
    764:    MatCreateMFFD - Creates a matrix-free matrix. See also MatCreateSNESMF()

    766:    Collective on Vec

    768:    Input Parameters:
    769: +  comm - MPI communicator
    770: .  m - number of local rows (or PETSC_DECIDE to have calculated if M is given)
    771:            This value should be the same as the local size used in creating the
    772:            y vector for the matrix-vector product y = Ax.
    773: .  n - This value should be the same as the local size used in creating the
    774:        x vector for the matrix-vector product y = Ax. (or PETSC_DECIDE to have
    775:        calculated if N is given) For square matrices n is almost always m.
    776: .  M - number of global rows (or PETSC_DETERMINE to have calculated if m is given)
    777: -  N - number of global columns (or PETSC_DETERMINE to have calculated if n is given)

    780:    Output Parameter:
    781: .  J - the matrix-free matrix

    783:    Options Database Keys: call MatSetFromOptions() to trigger these
    784: +  -mat_mffd_type - wp or ds (see MATMFFD_WP or MATMFFD_DS)
    785: -  -mat_mffd_err - square root of estimated relative error in function evaluation
    786: -  -mat_mffd_period - how often h is recomputed, defaults to 1, everytime

    789:    Level: advanced

    791:    Notes:
    792:    The matrix-free matrix context merely contains the function pointers
    793:    and work space for performing finite difference approximations of
    794:    Jacobian-vector products, F'(u)*a,

    796:    The default code uses the following approach to compute h

    798: .vb
    799:      F'(u)*a = [F(u+h*a) - F(u)]/h where
    800:      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
    801:        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   otherwise
    802:  where
    803:      error_rel = square root of relative error in function evaluation
    804:      umin = minimum iterate parameter
    805: .ve

    807:    The user can set the error_rel via MatMFFDSetFunctionError() and
    808:    umin via MatMFFDDSSetUmin(); see the <A href="../../docs/manual.pdf#nameddest=ch_snes">SNES chapter of the users manual</A> for details.

    810:    The user should call MatDestroy() when finished with the matrix-free
    811:    matrix context.

    813:    Options Database Keys:
    814: +  -mat_mffd_err <error_rel> - Sets error_rel
    815: .  -mat_mffd_unim <umin> - Sets umin (for default PETSc routine that computes h only)
    816: -  -mat_mffd_check_positivity

    818: .keywords: default, matrix-free, create, matrix

    820: .seealso: MatDestroy(), MatMFFDSetFunctionError(), MatMFFDDSSetUmin(), MatMFFDSetFunction()
    821:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), MatCreateSNESMF(),
    822:           MatMFFDGetH(), MatMFFDRegister(), MatMFFDComputeJacobian()

    824: @*/
    825: PetscErrorCode  MatCreateMFFD(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,Mat *J)
    826: {

    830:   MatCreate(comm,J);
    831:   MatSetSizes(*J,m,n,M,N);
    832:   MatSetType(*J,MATMFFD);
    833:   MatSetUp(*J);
    834:   return(0);
    835: }

    840: /*@
    841:    MatMFFDGetH - Gets the last value that was used as the differencing
    842:    parameter.

    844:    Not Collective

    846:    Input Parameters:
    847: .  mat - the matrix obtained with MatCreateSNESMF()

    849:    Output Paramter:
    850: .  h - the differencing step size

    852:    Level: advanced

    854: .keywords: SNES, matrix-free, parameters

    856: .seealso: MatCreateSNESMF(),MatMFFDSetHHistory(), MatCreateMFFD(), MATMFFD, MatMFFDResetHHistory()
    857: @*/
    858: PetscErrorCode  MatMFFDGetH(Mat mat,PetscScalar *h)
    859: {
    860:   MatMFFD        ctx = (MatMFFD)mat->data;
    862:   PetscBool      match;

    865:   PetscObjectTypeCompare((PetscObject)mat,MATMFFD,&match);
    866:   if (!match) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Not a MFFD matrix");

    868:   *h = ctx->currenth;
    869:   return(0);
    870: }

    874: /*@C
    875:    MatMFFDSetFunction - Sets the function used in applying the matrix free.

    877:    Logically Collective on Mat

    879:    Input Parameters:
    880: +  mat - the matrix free matrix created via MatCreateSNESMF()
    881: .  func - the function to use
    882: -  funcctx - optional function context passed to function

    884:    Level: advanced

    886:    Notes:
    887:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
    888:     matrix inside your compute Jacobian routine

    890:     If this is not set then it will use the function set with SNESSetFunction() if MatCreateSNESMF() was used.

    892: .keywords: SNES, matrix-free, function

    894: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD,
    895:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()
    896: @*/
    897: PetscErrorCode  MatMFFDSetFunction(Mat mat,PetscErrorCode (*func)(void*,Vec,Vec),void *funcctx)
    898: {

    902:   PetscTryMethod(mat,"MatMFFDSetFunction_C",(Mat,PetscErrorCode (*)(void*,Vec,Vec),void*),(mat,func,funcctx));
    903:   return(0);
    904: }

    908: /*@C
    909:    MatMFFDSetFunctioni - Sets the function for a single component

    911:    Logically Collective on Mat

    913:    Input Parameters:
    914: +  mat - the matrix free matrix created via MatCreateSNESMF()
    915: -  funci - the function to use

    917:    Level: advanced

    919:    Notes:
    920:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
    921:     matrix inside your compute Jacobian routine

    924: .keywords: SNES, matrix-free, function

    926: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()

    928: @*/
    929: PetscErrorCode  MatMFFDSetFunctioni(Mat mat,PetscErrorCode (*funci)(void*,PetscInt,Vec,PetscScalar*))
    930: {

    935:   PetscTryMethod(mat,"MatMFFDSetFunctioni_C",(Mat,PetscErrorCode (*)(void*,PetscInt,Vec,PetscScalar*)),(mat,funci));
    936:   return(0);
    937: }

    942: /*@C
    943:    MatMFFDSetFunctioniBase - Sets the base vector for a single component function evaluation

    945:    Logically Collective on Mat

    947:    Input Parameters:
    948: +  mat - the matrix free matrix created via MatCreateSNESMF()
    949: -  func - the function to use

    951:    Level: advanced

    953:    Notes:
    954:     If you use this you MUST call MatAssemblyBegin()/MatAssemblyEnd() on the matrix free
    955:     matrix inside your compute Jacobian routine

    958: .keywords: SNES, matrix-free, function

    960: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD
    961:           MatMFFDSetHHistory(), MatMFFDResetHHistory(), SNESetFunction()
    962: @*/
    963: PetscErrorCode  MatMFFDSetFunctioniBase(Mat mat,PetscErrorCode (*func)(void*,Vec))
    964: {

    969:   PetscTryMethod(mat,"MatMFFDSetFunctioniBase_C",(Mat,PetscErrorCode (*)(void*,Vec)),(mat,func));
    970:   return(0);
    971: }

    975: /*@
    976:    MatMFFDSetPeriod - Sets how often h is recomputed, by default it is everytime

    978:    Logically Collective on Mat

    980:    Input Parameters:
    981: +  mat - the matrix free matrix created via MatCreateSNESMF()
    982: -  period - 1 for everytime, 2 for every second etc

    984:    Options Database Keys:
    985: +  -mat_mffd_period <period>

    987:    Level: advanced

    990: .keywords: SNES, matrix-free, parameters

    992: .seealso: MatCreateSNESMF(),MatMFFDGetH(),
    993:           MatMFFDSetHHistory(), MatMFFDResetHHistory()
    994: @*/
    995: PetscErrorCode  MatMFFDSetPeriod(Mat mat,PetscInt period)
    996: {

    1000:   PetscTryMethod(mat,"MatMFFDSetPeriod_C",(Mat,PetscInt),(mat,period));
    1001:   return(0);
    1002: }

    1006: /*@
    1007:    MatMFFDSetFunctionError - Sets the error_rel for the approximation of
    1008:    matrix-vector products using finite differences.

    1010:    Logically Collective on Mat

    1012:    Input Parameters:
    1013: +  mat - the matrix free matrix created via MatCreateMFFD() or MatCreateSNESMF()
    1014: -  error_rel - relative error (should be set to the square root of
    1015:                the relative error in the function evaluations)

    1017:    Options Database Keys:
    1018: +  -mat_mffd_err <error_rel> - Sets error_rel

    1020:    Level: advanced

    1022:    Notes:
    1023:    The default matrix-free matrix-vector product routine computes
    1024: .vb
    1025:      F'(u)*a = [F(u+h*a) - F(u)]/h where
    1026:      h = error_rel*u'a/||a||^2                        if  |u'a| > umin*||a||_{1}
    1027:        = error_rel*umin*sign(u'a)*||a||_{1}/||a||^2   else
    1028: .ve

    1030: .keywords: SNES, matrix-free, parameters

    1032: .seealso: MatCreateSNESMF(),MatMFFDGetH(), MatCreateMFFD(), MATMFFD
    1033:           MatMFFDSetHHistory(), MatMFFDResetHHistory()
    1034: @*/
    1035: PetscErrorCode  MatMFFDSetFunctionError(Mat mat,PetscReal error)
    1036: {

    1040:   PetscTryMethod(mat,"MatMFFDSetFunctionError_C",(Mat,PetscReal),(mat,error));
    1041:   return(0);
    1042: }

    1046: /*@
    1047:    MatMFFDAddNullSpace - Provides a null space that an operator is
    1048:    supposed to have.  Since roundoff will create a small component in
    1049:    the null space, if you know the null space you may have it
    1050:    automatically removed.

    1052:    Logically Collective on Mat

    1054:    Input Parameters:
    1055: +  J - the matrix-free matrix context
    1056: -  nullsp - object created with MatNullSpaceCreate()

    1058:    Level: advanced

    1060: .keywords: SNES, matrix-free, null space

    1062: .seealso: MatNullSpaceCreate(), MatMFFDGetH(), MatCreateSNESMF(), MatCreateMFFD(), MATMFFD
    1063:           MatMFFDSetHHistory(), MatMFFDResetHHistory()
    1064: @*/
    1065: PetscErrorCode  MatMFFDAddNullSpace(Mat J,MatNullSpace nullsp)
    1066: {

    1070:   PetscTryMethod(J,"MatMFFDAddNullSpace_C",(Mat,MatNullSpace),(J,nullsp));
    1071:   return(0);
    1072: }

    1076: /*@
    1077:    MatMFFDSetHHistory - Sets an array to collect a history of the
    1078:    differencing values (h) computed for the matrix-free product.

    1080:    Logically Collective on Mat

    1082:    Input Parameters:
    1083: +  J - the matrix-free matrix context
    1084: .  histroy - space to hold the history
    1085: -  nhistory - number of entries in history, if more entries are generated than
    1086:               nhistory, then the later ones are discarded

    1088:    Level: advanced

    1090:    Notes:
    1091:    Use MatMFFDResetHHistory() to reset the history counter and collect
    1092:    a new batch of differencing parameters, h.

    1094: .keywords: SNES, matrix-free, h history, differencing history

    1096: .seealso: MatMFFDGetH(), MatCreateSNESMF(),
    1097:           MatMFFDResetHHistory(), MatMFFDSetFunctionError()

    1099: @*/
    1100: PetscErrorCode  MatMFFDSetHHistory(Mat J,PetscScalar history[],PetscInt nhistory)
    1101: {
    1102:   MatMFFD        ctx = (MatMFFD)J->data;
    1104:   PetscBool      match;

    1107:   PetscObjectTypeCompare((PetscObject)J,MATMFFD,&match);
    1108:   if (!match) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONG,"Not a MFFD matrix");
    1109:   ctx->historyh    = history;
    1110:   ctx->maxcurrenth = nhistory;
    1111:   ctx->currenth    = 0.;
    1112:   return(0);
    1113: }

    1118: /*@
    1119:    MatMFFDResetHHistory - Resets the counter to zero to begin
    1120:    collecting a new set of differencing histories.

    1122:    Logically Collective on Mat

    1124:    Input Parameters:
    1125: .  J - the matrix-free matrix context

    1127:    Level: advanced

    1129:    Notes:
    1130:    Use MatMFFDSetHHistory() to create the original history counter.

    1132: .keywords: SNES, matrix-free, h history, differencing history

    1134: .seealso: MatMFFDGetH(), MatCreateSNESMF(),
    1135:           MatMFFDSetHHistory(), MatMFFDSetFunctionError()

    1137: @*/
    1138: PetscErrorCode  MatMFFDResetHHistory(Mat J)
    1139: {

    1143:   PetscTryMethod(J,"MatMFFDResetHHistory_C",(Mat),(J));
    1144:   return(0);
    1145: }

    1150: /*@
    1151:     MatMFFDSetBase - Sets the vector U at which matrix vector products of the
    1152:         Jacobian are computed

    1154:     Logically Collective on Mat

    1156:     Input Parameters:
    1157: +   J - the MatMFFD matrix
    1158: .   U - the vector
    1159: -   F - (optional) vector that contains F(u) if it has been already computed

    1161:     Notes: This is rarely used directly

    1163:     If F is provided then it is not recomputed. Otherwise the function is evaluated at the base
    1164:     point during the first MatMult() after each call to MatMFFDSetBase().

    1166:     Level: advanced

    1168: @*/
    1169: PetscErrorCode  MatMFFDSetBase(Mat J,Vec U,Vec F)
    1170: {

    1177:   PetscTryMethod(J,"MatMFFDSetBase_C",(Mat,Vec,Vec),(J,U,F));
    1178:   return(0);
    1179: }

    1183: /*@C
    1184:     MatMFFDSetCheckh - Sets a function that checks the computed h and adjusts
    1185:         it to satisfy some criteria

    1187:     Logically Collective on Mat

    1189:     Input Parameters:
    1190: +   J - the MatMFFD matrix
    1191: .   fun - the function that checks h
    1192: -   ctx - any context needed by the function

    1194:     Options Database Keys:
    1195: .   -mat_mffd_check_positivity

    1197:     Level: advanced

    1199:     Notes: For example, MatMFFDSetCheckPositivity() insures that all entries
    1200:        of U + h*a are non-negative

    1202: .seealso:  MatMFFDSetCheckPositivity()
    1203: @*/
    1204: PetscErrorCode  MatMFFDSetCheckh(Mat J,PetscErrorCode (*fun)(void*,Vec,Vec,PetscScalar*),void *ctx)
    1205: {

    1210:   PetscTryMethod(J,"MatMFFDSetCheckh_C",(Mat,PetscErrorCode (*)(void*,Vec,Vec,PetscScalar*),void*),(J,fun,ctx));
    1211:   return(0);
    1212: }

    1216: /*@
    1217:     MatMFFDCheckPositivity - Checks that all entries in U + h*a are positive or
    1218:         zero, decreases h until this is satisfied.

    1220:     Logically Collective on Vec

    1222:     Input Parameters:
    1223: +   U - base vector that is added to
    1224: .   a - vector that is added
    1225: .   h - scaling factor on a
    1226: -   dummy - context variable (unused)

    1228:     Options Database Keys:
    1229: .   -mat_mffd_check_positivity

    1231:     Level: advanced

    1233:     Notes: This is rarely used directly, rather it is passed as an argument to
    1234:            MatMFFDSetCheckh()

    1236: .seealso:  MatMFFDSetCheckh()
    1237: @*/
    1238: PetscErrorCode  MatMFFDCheckPositivity(void *dummy,Vec U,Vec a,PetscScalar *h)
    1239: {
    1240:   PetscReal      val, minval;
    1241:   PetscScalar    *u_vec, *a_vec;
    1243:   PetscInt       i,n;
    1244:   MPI_Comm       comm;

    1247:   PetscObjectGetComm((PetscObject)U,&comm);
    1248:   VecGetArray(U,&u_vec);
    1249:   VecGetArray(a,&a_vec);
    1250:   VecGetLocalSize(U,&n);
    1251:   minval = PetscAbsScalar(*h*1.01);
    1252:   for (i=0; i<n; i++) {
    1253:     if (PetscRealPart(u_vec[i] + *h*a_vec[i]) <= 0.0) {
    1254:       val = PetscAbsScalar(u_vec[i]/a_vec[i]);
    1255:       if (val < minval) minval = val;
    1256:     }
    1257:   }
    1258:   VecRestoreArray(U,&u_vec);
    1259:   VecRestoreArray(a,&a_vec);
    1260:   MPI_Allreduce(&minval,&val,1,MPIU_REAL,MPIU_MIN,comm);
    1261:   if (val <= PetscAbsScalar(*h)) {
    1262:     PetscInfo2(U,"Scaling back h from %G to %G\n",PetscRealPart(*h),.99*val);
    1263:     if (PetscRealPart(*h) > 0.0) *h =  0.99*val;
    1264:     else                         *h = -0.99*val;
    1265:   }
    1266:   return(0);
    1267: }