Date: 2016-03-29T14:57:04+00:00

Actual source code: fnbasic.c
slepc-3.6.3 2016-03-29
Report Typos and Errors

      1: /*
      2:      Basic routines

      4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      6:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

      8:    This file is part of SLEPc.

     10:    SLEPc is free software: you can redistribute it and/or modify it under  the
     11:    terms of version 3 of the GNU Lesser General Public License as published by
     12:    the Free Software Foundation.

     14:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     15:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     16:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     17:    more details.

     19:    You  should have received a copy of the GNU Lesser General  Public  License
     20:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     21:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     22: */

     24: #include <slepc/private/fnimpl.h>      /*I "slepcfn.h" I*/
     25: #include <slepcblaslapack.h>

     27: PetscFunctionList FNList = 0;
     28: PetscBool         FNRegisterAllCalled = PETSC_FALSE;
     29: PetscClassId      FN_CLASSID = 0;
     30: PetscLogEvent     FN_Evaluate = 0;
     31: static PetscBool  FNPackageInitialized = PETSC_FALSE;

     35: /*@C
     36:    FNFinalizePackage - This function destroys everything in the Slepc interface
     37:    to the FN package. It is called from SlepcFinalize().

     39:    Level: developer

     41: .seealso: SlepcFinalize()
     42: @*/
     43: PetscErrorCode FNFinalizePackage(void)
     44: {

     48:   PetscFunctionListDestroy(&FNList);
     49:   FNPackageInitialized = PETSC_FALSE;
     50:   FNRegisterAllCalled  = PETSC_FALSE;
     51:   return(0);
     52: }

     56: /*@C
     57:   FNInitializePackage - This function initializes everything in the FN package.
     58:   It is called from PetscDLLibraryRegister() when using dynamic libraries, and
     59:   on the first call to FNCreate() when using static libraries.

     61:   Level: developer

     63: .seealso: SlepcInitialize()
     64: @*/
     65: PetscErrorCode FNInitializePackage(void)
     66: {
     67:   char             logList[256];
     68:   char             *className;
     69:   PetscBool        opt;
     70:   PetscErrorCode   ierr;

     73:   if (FNPackageInitialized) return(0);
     74:   FNPackageInitialized = PETSC_TRUE;
     75:   /* Register Classes */
     76:   PetscClassIdRegister("Math Function",&FN_CLASSID);
     77:   /* Register Constructors */
     78:   FNRegisterAll();
     79:   /* Register Events */
     80:   PetscLogEventRegister("FNEvaluate",FN_CLASSID,&FN_Evaluate);
     81:   /* Process info exclusions */
     82:   PetscOptionsGetString(NULL,"-info_exclude",logList,256,&opt);
     83:   if (opt) {
     84:     PetscStrstr(logList,"fn",&className);
     85:     if (className) {
     86:       PetscInfoDeactivateClass(FN_CLASSID);
     87:     }
     88:   }
     89:   /* Process summary exclusions */
     90:   PetscOptionsGetString(NULL,"-log_summary_exclude",logList,256,&opt);
     91:   if (opt) {
     92:     PetscStrstr(logList,"fn",&className);
     93:     if (className) {
     94:       PetscLogEventDeactivateClass(FN_CLASSID);
     95:     }
     96:   }
     97:   PetscRegisterFinalize(FNFinalizePackage);
     98:   return(0);
     99: }

    103: /*@
    104:    FNCreate - Creates an FN context.

    106:    Collective on MPI_Comm

    108:    Input Parameter:
    109: .  comm - MPI communicator

    111:    Output Parameter:
    112: .  newfn - location to put the FN context

    114:    Level: beginner

    116: .seealso: FNDestroy(), FN
    117: @*/
    118: PetscErrorCode FNCreate(MPI_Comm comm,FN *newfn)
    119: {
    120:   FN             fn;

    125:   *newfn = 0;
    126:   FNInitializePackage();
    127:   SlepcHeaderCreate(fn,FN_CLASSID,"FN","Math Function","FN",comm,FNDestroy,FNView);

    129:   fn->alpha    = 1.0;
    130:   fn->beta     = 1.0;

    132:   fn->W        = NULL;
    133:   fn->data     = NULL;

    135:   *newfn = fn;
    136:   return(0);
    137: }

    141: /*@C
    142:    FNSetOptionsPrefix - Sets the prefix used for searching for all
    143:    FN options in the database.

    145:    Logically Collective on FN

    147:    Input Parameters:
    148: +  fn - the math function context
    149: -  prefix - the prefix string to prepend to all FN option requests

    151:    Notes:
    152:    A hyphen (-) must NOT be given at the beginning of the prefix name.
    153:    The first character of all runtime options is AUTOMATICALLY the
    154:    hyphen.

    156:    Level: advanced

    158: .seealso: FNAppendOptionsPrefix()
    159: @*/
    160: PetscErrorCode FNSetOptionsPrefix(FN fn,const char *prefix)
    161: {

    166:   PetscObjectSetOptionsPrefix((PetscObject)fn,prefix);
    167:   return(0);
    168: }

    172: /*@C
    173:    FNAppendOptionsPrefix - Appends to the prefix used for searching for all
    174:    FN options in the database.

    176:    Logically Collective on FN

    178:    Input Parameters:
    179: +  fn - the math function context
    180: -  prefix - the prefix string to prepend to all FN option requests

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

    186:    Level: advanced

    188: .seealso: FNSetOptionsPrefix()
    189: @*/
    190: PetscErrorCode FNAppendOptionsPrefix(FN fn,const char *prefix)
    191: {

    196:   PetscObjectAppendOptionsPrefix((PetscObject)fn,prefix);
    197:   return(0);
    198: }

    202: /*@C
    203:    FNGetOptionsPrefix - Gets the prefix used for searching for all
    204:    FN options in the database.

    206:    Not Collective

    208:    Input Parameters:
    209: .  fn - the math function context

    211:    Output Parameters:
    212: .  prefix - pointer to the prefix string used is returned

    214:    Notes: On the fortran side, the user should pass in a string 'prefix' of
    215:    sufficient length to hold the prefix.

    217:    Level: advanced

    219: .seealso: FNSetOptionsPrefix(), FNAppendOptionsPrefix()
    220: @*/
    221: PetscErrorCode FNGetOptionsPrefix(FN fn,const char *prefix[])
    222: {

    228:   PetscObjectGetOptionsPrefix((PetscObject)fn,prefix);
    229:   return(0);
    230: }

    234: /*@C
    235:    FNSetType - Selects the type for the FN object.

    237:    Logically Collective on FN

    239:    Input Parameter:
    240: +  fn   - the math function context
    241: -  type - a known type

    243:    Notes:
    244:    The default is FNRATIONAL, which includes polynomials as a particular
    245:    case as well as simple functions such as f(x)=x and f(x)=constant.

    247:    Level: intermediate

    249: .seealso: FNGetType()
    250: @*/
    251: PetscErrorCode FNSetType(FN fn,FNType type)
    252: {
    253:   PetscErrorCode ierr,(*r)(FN);
    254:   PetscBool      match;

    260:   PetscObjectTypeCompare((PetscObject)fn,type,&match);
    261:   if (match) return(0);

    263:    PetscFunctionListFind(FNList,type,&r);
    264:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested FN type %s",type);

    266:   if (fn->ops->destroy) { (*fn->ops->destroy)(fn); }
    267:   PetscMemzero(fn->ops,sizeof(struct _FNOps));

    269:   PetscObjectChangeTypeName((PetscObject)fn,type);
    270:   (*r)(fn);
    271:   return(0);
    272: }

    276: /*@C
    277:    FNGetType - Gets the FN type name (as a string) from the FN context.

    279:    Not Collective

    281:    Input Parameter:
    282: .  fn - the math function context

    284:    Output Parameter:
    285: .  name - name of the math function

    287:    Level: intermediate

    289: .seealso: FNSetType()
    290: @*/
    291: PetscErrorCode FNGetType(FN fn,FNType *type)
    292: {
    296:   *type = ((PetscObject)fn)->type_name;
    297:   return(0);
    298: }

    302: /*@
    303:    FNSetScale - Sets the scaling parameters that define the matematical function.

    305:    Logically Collective on FN

    307:    Input Parameters:
    308: +  fn    - the math function context
    309: .  alpha - inner scaling (argument)
    310: -  beta  - outer scaling (result)

    312:    Notes:
    313:    Given a function f(x) specified by the FN type, the scaling parameters can
    314:    be used to realize the function beta*f(alpha*x). So when these values are given,
    315:    the procedure for function evaluation will first multiply the argument by alpha,
    316:    then evaluate the function itself, and finally scale the result by beta.
    317:    Likewise, these values are also considered when evaluating the derivative.

    319:    If you want to provide only one of the two scaling factors, set the other
    320:    one to 1.0.

    322:    Level: intermediate

    324: .seealso: FNGetScale(), FNEvaluateFunction()
    325: @*/
    326: PetscErrorCode FNSetScale(FN fn,PetscScalar alpha,PetscScalar beta)
    327: {
    332:   fn->alpha = alpha;
    333:   fn->beta  = beta;
    334:   return(0);
    335: }

    339: /*@
    340:    FNGetScale - Gets the scaling parameters that define the matematical function.

    342:    Not Collective

    344:    Input Parameter:
    345: .  fn    - the math function context

    347:    Output Parameters:
    348: +  alpha - inner scaling (argument)
    349: -  beta  - outer scaling (result)

    351:    Level: intermediate

    353: .seealso: FNSetScale()
    354: @*/
    355: PetscErrorCode FNGetScale(FN fn,PetscScalar *alpha,PetscScalar *beta)
    356: {
    359:   if (alpha) *alpha = fn->alpha;
    360:   if (beta)  *beta  = fn->beta;
    361:   return(0);
    362: }

    366: /*@
    367:    FNEvaluateFunction - Computes the value of the function f(x) for a given x.

    369:    Logically Collective on FN

    371:    Input Parameters:
    372: +  fn - the math function context
    373: -  x  - the value where the function must be evaluated

    375:    Output Parameter:
    376: .  y  - the result of f(x)

    378:    Note:
    379:    Scaling factors are taken into account, so the actual function evaluation
    380:    will return beta*f(alpha*x).

    382:    Level: intermediate

    384: .seealso: FNEvaluateDerivative(), FNEvaluateFunctionMat(), FNSetScale()
    385: @*/
    386: PetscErrorCode FNEvaluateFunction(FN fn,PetscScalar x,PetscScalar *y)
    387: {
    389:   PetscScalar    xf,yf;

    396:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
    397:   xf = fn->alpha*x;
    398:   (*fn->ops->evaluatefunction)(fn,xf,&yf);
    399:   *y = fn->beta*yf;
    400:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
    401:   return(0);
    402: }

    406: /*@
    407:    FNEvaluateDerivative - Computes the value of the derivative f'(x) for a given x.

    409:    Logically Collective on FN

    411:    Input Parameters:
    412: +  fn - the math function context
    413: -  x  - the value where the derivative must be evaluated

    415:    Output Parameter:
    416: .  y  - the result of f'(x)

    418:    Note:
    419:    Scaling factors are taken into account, so the actual derivative evaluation will
    420:    return alpha*beta*f'(alpha*x).

    422:    Level: intermediate

    424: .seealso: FNEvaluateFunction()
    425: @*/
    426: PetscErrorCode FNEvaluateDerivative(FN fn,PetscScalar x,PetscScalar *y)
    427: {
    429:   PetscScalar    xf,yf;

    436:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
    437:   xf = fn->alpha*x;
    438:   (*fn->ops->evaluatederivative)(fn,xf,&yf);
    439:   *y = fn->alpha*fn->beta*yf;
    440:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);
    441:   return(0);
    442: }

    446: /*
    447:    FNEvaluateFunctionMat_Sym_Default - given a symmetric matrix A,
    448:    compute the matrix function as f(A)=Q*f(D)*Q' where the spectral
    449:    decomposition of A is A=Q*D*Q'
    450: */
    451: static PetscErrorCode FNEvaluateFunctionMat_Sym_Default(FN fn,Mat A,Mat B)
    452: {
    453: #if defined(PETSC_MISSING_LAPACK_SYEV)
    455:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"SYEV - Lapack routines are unavailable");
    456: #else
    458:   PetscInt       i,j,m;
    459:   PetscBLASInt   n,ld,lwork,info;
    460:   PetscScalar    *As,*Bs,*Q,*W,*work,a,x,y,one=1.0,zero=0.0;
    461:   PetscReal      *eig;
    462: #if defined(PETSC_USE_COMPLEX)
    463:   PetscReal      *rwork;
    464: #endif

    467:   MatDenseGetArray(A,&As);
    468:   MatDenseGetArray(B,&Bs);
    469:   MatGetSize(A,&m,NULL);
    470:   PetscBLASIntCast(m,&n);
    471:   ld = n;

    473:   /* workspace query and memory allocation */
    474:   lwork = -1;
    475: #if defined(PETSC_USE_COMPLEX)
    476:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,NULL,&a,&lwork,NULL,&info));
    477:   PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
    478:   PetscMalloc5(m,&eig,m*m,&Q,m*m,&W,lwork,&work,PetscMax(1,3*m-2),&rwork);
    479: #else
    480:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,As,&ld,NULL,&a,&lwork,&info));
    481:   PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork);
    482:   PetscMalloc4(m,&eig,m*m,&Q,m*m,&W,lwork,&work);
    483: #endif

    485:   /* compute eigendecomposition */
    486:   PetscStackCallBLAS("LAPACKlacpy",LAPACKlacpy_("L",&n,&n,As,&ld,Q,&ld));
    487: #if defined(PETSC_USE_COMPLEX)
    488:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,rwork,&info));
    489: #else
    490:   PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","L",&n,Q,&ld,eig,work,&lwork,&info));
    491: #endif
    492:   if (info) SETERRQ1(PetscObjectComm((PetscObject)fn),PETSC_ERR_LIB,"Error in Lapack xSYEV %i",info);

    494:   /* W = f(Lambda)*Q' */
    495:   for (i=0;i<n;i++) {
    496:     x = eig[i];
    497:     (*fn->ops->evaluatefunction)(fn,x,&y);  /* y = f(x) */
    498:     for (j=0;j<n;j++) W[i+j*ld] = Q[j+i*ld]*y;
    499:   }
    500:   /* Bs = Q*W */
    501:   PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Q,&ld,W,&ld,&zero,Bs,&ld));
    502: #if defined(PETSC_USE_COMPLEX)
    503:   PetscFree5(eig,Q,W,work,rwork);
    504: #else
    505:   PetscFree4(eig,Q,W,work);
    506: #endif
    507:   MatDenseRestoreArray(A,&As);
    508:   MatDenseRestoreArray(B,&Bs);
    509:   return(0);
    510: #endif
    511: }

    515: /*@
    516:    FNEvaluateFunctionMat - Computes the value of the function f(A) for a given
    517:    matrix A, where the result is also a matrix.

    519:    Logically Collective on FN

    521:    Input Parameters:
    522: +  fn - the math function context
    523: -  A  - matrix on which the function must be evaluated

    525:    Output Parameter:
    526: .  B  - matrix resulting from evaluating f(A)

    528:    Notes:
    529:    The matrix A must be a sequential dense Mat, with all entries equal on
    530:    all processes (otherwise each process will compute different results).
    531:    Matrix B must also be a sequential dense Mat. Both matrices must be
    532:    square with the same dimensions.

    534:    If A is known to be real symmetric or complex Hermitian then it is
    535:    recommended to set the appropriate flag with MatSetOption(), so that
    536:    a different algorithm that exploits symmetry is used.

    538:    Scaling factors are taken into account, so the actual function evaluation
    539:    will return beta*f(alpha*A).

    541:    Level: advanced

    543: .seealso: FNEvaluateFunction()
    544: @*/
    545: PetscErrorCode FNEvaluateFunctionMat(FN fn,Mat A,Mat B)
    546: {
    548:   PetscBool      match,set,flg,symm=PETSC_FALSE;
    549:   PetscInt       m,n,n1;
    550:   Mat            M;

    559:   if (A==B) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_WRONG,"A and B arguments must be different");
    560:   PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&match);
    561:   if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat A must be of type seqdense");
    562:   PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&match);
    563:   if (!match) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Mat B must be of type seqdense");
    564:   MatGetSize(A,&m,&n);
    565:   if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat A is not square (has %D rows, %D cols)",m,n);
    566:   n1 = n;
    567:   MatGetSize(B,&m,&n);
    568:   if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Mat B is not square (has %D rows, %D cols)",m,n);
    569:   if (n1!=n) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_SIZ,"Matrices A and B must have the same dimension");

    571:   /* check symmetry of A */
    572:   MatIsHermitianKnown(A,&set,&flg);
    573:   symm = set? flg: PETSC_FALSE;

    575:   /* scale argument */
    576:   if (fn->alpha!=(PetscScalar)1.0) {
    577:     FN_AllocateWorkMat(fn,A);
    578:     M = fn->W;
    579:     MatScale(M,fn->alpha);
    580:   } else M = A;

    582:   /* evaluate matrix function */
    583:   PetscLogEventBegin(FN_Evaluate,fn,0,0,0);
    584:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    585:   if (symm) {
    586:     if (fn->ops->evaluatefunctionmatsym) {
    587:       (*fn->ops->evaluatefunctionmatsym)(fn,M,B);
    588:     } else {
    589:       FNEvaluateFunctionMat_Sym_Default(fn,M,B);
    590:     }
    591:   } else {
    592:     if (fn->ops->evaluatefunctionmat) {
    593:       (*fn->ops->evaluatefunctionmat)(fn,M,B);
    594:     } else SETERRQ1(PetscObjectComm((PetscObject)fn),PETSC_ERR_SUP,"Matrix functions not implemented in FN type %s",((PetscObject)fn)->type_name);
    595:   }
    596:   PetscFPTrapPop();
    597:   PetscLogEventEnd(FN_Evaluate,fn,0,0,0);

    599:   /* scale result */
    600:   MatScale(B,fn->beta);
    601:   return(0);
    602: }

    606: /*@
    607:    FNSetFromOptions - Sets FN options from the options database.

    609:    Collective on FN

    611:    Input Parameters:
    612: .  fn - the math function context

    614:    Notes:
    615:    To see all options, run your program with the -help option.

    617:    Level: beginner
    618: @*/
    619: PetscErrorCode FNSetFromOptions(FN fn)
    620: {
    622:   char           type[256];
    623:   PetscScalar    array[2];
    624:   PetscInt       k;
    625:   PetscBool      flg;

    629:   FNRegisterAll();
    630:   PetscObjectOptionsBegin((PetscObject)fn);
    631:     PetscOptionsFList("-fn_type","Math function type","FNSetType",FNList,(char*)(((PetscObject)fn)->type_name?((PetscObject)fn)->type_name:FNRATIONAL),type,256,&flg);
    632:     if (flg) {
    633:       FNSetType(fn,type);
    634:     }
    635:     /*
    636:       Set the type if it was never set.
    637:     */
    638:     if (!((PetscObject)fn)->type_name) {
    639:       FNSetType(fn,FNRATIONAL);
    640:     }

    642:     k = 2;
    643:     array[0] = 0.0; array[1] = 0.0;
    644:     PetscOptionsScalarArray("-fn_scale","Scale factors (one or two scalar values separated with a comma without spaces)","FNSetScale",array,&k,&flg);
    645:     if (flg) {
    646:       if (k<2) array[1] = 1.0;
    647:       FNSetScale(fn,array[0],array[1]);
    648:     }

    650:     if (fn->ops->setfromoptions) {
    651:       (*fn->ops->setfromoptions)(PetscOptionsObject,fn);
    652:     }
    653:     PetscObjectProcessOptionsHandlers((PetscObject)fn);
    654:   PetscOptionsEnd();
    655:   return(0);
    656: }

    660: /*@C
    661:    FNView - Prints the FN data structure.

    663:    Collective on FN

    665:    Input Parameters:
    666: +  fn - the math function context
    667: -  viewer - optional visualization context

    669:    Note:
    670:    The available visualization contexts include
    671: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
    672: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
    673:          output where only the first processor opens
    674:          the file.  All other processors send their
    675:          data to the first processor to print.

    677:    The user can open an alternative visualization context with
    678:    PetscViewerASCIIOpen() - output to a specified file.

    680:    Level: beginner
    681: @*/
    682: PetscErrorCode FNView(FN fn,PetscViewer viewer)
    683: {
    684:   PetscBool      isascii;

    689:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)fn));
    692:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    693:   if (isascii) {
    694:     PetscObjectPrintClassNamePrefixType((PetscObject)fn,viewer);
    695:     if (fn->ops->view) {
    696:       PetscViewerASCIIPushTab(viewer);
    697:       (*fn->ops->view)(fn,viewer);
    698:       PetscViewerASCIIPopTab(viewer);
    699:     }
    700:   }
    701:   return(0);
    702: }

    706: /*@
    707:    FNDuplicate - Duplicates a math function, copying all parameters, possibly with a
    708:    different communicator.

    710:    Collective on FN

    712:    Input Parameters:
    713: +  fn   - the math function context
    714: -  comm - MPI communicator (may be NULL)

    716:    Output Parameter:
    717: .  newfn - location to put the new FN context

    719:    Level: developer

    721: .seealso: FNCreate()
    722: @*/
    723: PetscErrorCode FNDuplicate(FN fn,MPI_Comm comm,FN *newfn)
    724: {
    726:   FNType         type;
    727:   PetscScalar    alpha,beta;

    733:   if (!comm) comm = PetscObjectComm((PetscObject)fn);
    734:   FNCreate(comm,newfn);
    735:   FNGetType(fn,&type);
    736:   FNSetType(*newfn,type);
    737:   FNGetScale(fn,&alpha,&beta);
    738:   FNSetScale(*newfn,alpha,beta);
    739:   if (fn->ops->duplicate) {
    740:     (*fn->ops->duplicate)(fn,comm,newfn);
    741:   }
    742:   return(0);
    743: }

    747: /*@
    748:    FNDestroy - Destroys FN context that was created with FNCreate().

    750:    Collective on FN

    752:    Input Parameter:
    753: .  fn - the math function context

    755:    Level: beginner

    757: .seealso: FNCreate()
    758: @*/
    759: PetscErrorCode FNDestroy(FN *fn)
    760: {

    764:   if (!*fn) return(0);
    766:   if (--((PetscObject)(*fn))->refct > 0) { *fn = 0; return(0); }
    767:   if ((*fn)->ops->destroy) { (*(*fn)->ops->destroy)(*fn); }
    768:   MatDestroy(&(*fn)->W);
    769:   PetscHeaderDestroy(fn);
    770:   return(0);
    771: }

    775: /*@C
    776:    FNRegister - See Adds a mathematical function to the FN package.

    778:    Not collective

    780:    Input Parameters:
    781: +  name - name of a new user-defined FN
    782: -  function - routine to create context

    784:    Notes:
    785:    FNRegister() may be called multiple times to add several user-defined inner products.

    787:    Level: advanced

    789: .seealso: FNRegisterAll()
    790: @*/
    791: PetscErrorCode FNRegister(const char *name,PetscErrorCode (*function)(FN))
    792: {

    796:   PetscFunctionListAdd(&FNList,name,function);
    797:   return(0);
    798: }