Date: 2013-09-02T10:09:50+00:00

Actual source code: fnbasic.c

      1: /*
      2:      Basic routines

      4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      6:    Copyright (c) 2002-2013, 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*/

     26: PetscFunctionList FNList = 0;
     27: PetscBool         FNRegisterAllCalled = PETSC_FALSE;
     28: PetscClassId      FN_CLASSID = 0;
     29: static PetscBool  FNPackageInitialized = PETSC_FALSE;

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

     37:    Level: developer

     39: .seealso: SlepcFinalize()
     40: @*/
     41: PetscErrorCode FNFinalizePackage(void)
     42: {

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

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

     59:   Level: developer

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

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

     99: /*@C
    100:    FNCreate - Creates an FN context.

    102:    Collective on MPI_Comm

    104:    Input Parameter:
    105: .  comm - MPI communicator

    107:    Output Parameter:
    108: .  newfn - location to put the FN context

    110:    Level: beginner

    112: .seealso: FNDestroy(), FN
    113: @*/
    114: PetscErrorCode FNCreate(MPI_Comm comm,FN *newfn)
    115: {
    116:   FN             fn;

    121:   *newfn = 0;
    122: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
    123:   FNInitializePackage();
    124: #endif

    126:   SlepcHeaderCreate(fn,_p_FN,struct _FNOps,FN_CLASSID,"FN","Math Function","FN",comm,FNDestroy,FNView);
    127:   fn->na       = 0;
    128:   fn->alpha    = NULL;
    129:   fn->nb       = 0;
    130:   fn->beta     = NULL;

    132:   *newfn = fn;
    133:   return(0);
    134: }

    138: /*@C
    139:    FNSetOptionsPrefix - Sets the prefix used for searching for all
    140:    FN options in the database.

    142:    Logically Collective on FN

    144:    Input Parameters:
    145: +  fn - the math function context
    146: -  prefix - the prefix string to prepend to all FN option requests

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

    153:    Level: advanced

    155: .seealso: FNAppendOptionsPrefix()
    156: @*/
    157: PetscErrorCode FNSetOptionsPrefix(FN fn,const char *prefix)
    158: {

    163:   PetscObjectSetOptionsPrefix((PetscObject)fn,prefix);
    164:   return(0);
    165: }

    169: /*@C
    170:    FNAppendOptionsPrefix - Appends to the prefix used for searching for all
    171:    FN options in the database.

    173:    Logically Collective on FN

    175:    Input Parameters:
    176: +  fn - the math function context
    177: -  prefix - the prefix string to prepend to all FN option requests

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

    183:    Level: advanced

    185: .seealso: FNSetOptionsPrefix()
    186: @*/
    187: PetscErrorCode FNAppendOptionsPrefix(FN fn,const char *prefix)
    188: {

    193:   PetscObjectAppendOptionsPrefix((PetscObject)fn,prefix);
    194:   return(0);
    195: }

    199: /*@C
    200:    FNGetOptionsPrefix - Gets the prefix used for searching for all
    201:    FN options in the database.

    203:    Not Collective

    205:    Input Parameters:
    206: .  fn - the math function context

    208:    Output Parameters:
    209: .  prefix - pointer to the prefix string used is returned

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

    214:    Level: advanced

    216: .seealso: FNSetOptionsPrefix(), FNAppendOptionsPrefix()
    217: @*/
    218: PetscErrorCode FNGetOptionsPrefix(FN fn,const char *prefix[])
    219: {

    225:   PetscObjectGetOptionsPrefix((PetscObject)fn,prefix);
    226:   return(0);
    227: }

    231: /*@C
    232:    FNSetType - Selects the type for the FN object.

    234:    Logically Collective on FN

    236:    Input Parameter:
    237: +  fn   - the math function context
    238: -  type - a known type

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

    244:    Level: intermediate

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

    257:   PetscObjectTypeCompare((PetscObject)fn,type,&match);
    258:   if (match) return(0);

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

    263:   PetscMemzero(fn->ops,sizeof(struct _FNOps));

    265:   PetscObjectChangeTypeName((PetscObject)fn,type);
    266:   (*r)(fn);
    267:   return(0);
    268: }

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

    275:    Not Collective

    277:    Input Parameter:
    278: .  fn - the math function context

    280:    Output Parameter:
    281: .  name - name of the math function

    283:    Level: intermediate

    285: .seealso: FNSetType()
    286: @*/
    287: PetscErrorCode FNGetType(FN fn,FNType *type)
    288: {
    292:   *type = ((PetscObject)fn)->type_name;
    293:   return(0);
    294: }

    298: /*@
    299:    FNSetParameters - Sets the parameters that define the matematical function.

    301:    Logically Collective on FN

    303:    Input Parameters:
    304: +  fn    - the math function context
    305: .  na    - number of parameters in the first group
    306: .  alpha - first group of parameters (array of scalar values)
    307: .  nb    - number of parameters in the second group
    308: -  beta  - second group of parameters (array of scalar values)

    310:    Notes:
    311:    In a rational function r(x) = p(x)/q(x), where p(x) and q(x) are polynomials,
    312:    the parameters alpha and beta represent the coefficients of p(x) and q(x),
    313:    respectively. Hence, p(x) is of degree na-1 and q(x) of degree nb-1.
    314:    If nb is zero, then the function is assumed to be polynomial, r(x) = p(x).

    316:    In other functions the parameters have other meanings.

    318:    In polynomials, high order coefficients are stored in the first positions
    319:    of the array, e.g. to represent x^2-3 use {1,0,-3}.

    321:    Level: intermediate

    323: .seealso: FNGetParameters()
    324: @*/
    325: PetscErrorCode FNSetParameters(FN fn,PetscInt na,PetscScalar *alpha,PetscInt nb,PetscScalar *beta)
    326: {
    328:   PetscInt       i;

    333:   if (na<0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Argument na cannot be negative");
    336:   if (nb<0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Argument nb cannot be negative");
    338:   fn->na = na;
    339:   PetscFree(fn->alpha);
    340:   if (na) {
    341:     PetscMalloc(na*sizeof(PetscScalar),&fn->alpha);
    342:     PetscLogObjectMemory(fn,na*sizeof(PetscScalar));
    343:     for (i=0;i<na;i++) fn->alpha[i] = alpha[i];
    344:   }
    345:   fn->nb = nb;
    346:   PetscFree(fn->beta);
    347:   if (nb) {
    348:     PetscMalloc(nb*sizeof(PetscScalar),&fn->beta);
    349:     PetscLogObjectMemory(fn,nb*sizeof(PetscScalar));
    350:     for (i=0;i<nb;i++) fn->beta[i] = beta[i];
    351:   }
    352:   return(0);
    353: }

    357: /*@
    358:    FNGetParameters - Returns the parameters that define the matematical function.

    360:    Not Collective

    362:    Input Parameter:
    363: .  fn    - the math function context

    365:    Output Parameters:
    366: +  na    - number of parameters in the first group
    367: .  alpha - first group of parameters (array of scalar values)
    368: .  nb    - number of parameters in the second group
    369: -  beta  - second group of parameters (array of scalar values)

    371:    Level: intermediate

    373: .seealso: FNSetParameters()
    374: @*/
    375: PetscErrorCode FNGetParameters(FN fn,PetscInt *na,PetscScalar *alpha[],PetscInt *nb,PetscScalar *beta[])
    376: {
    379:   if (na)    *na = fn->na;
    380:   if (alpha) *alpha = fn->alpha;
    381:   if (nb)    *nb = fn->nb;
    382:   if (beta)  *beta = fn->beta;
    383:   return(0);
    384: }

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

    391:    Logically Collective on FN

    393:    Input Parameters:
    394: +  fn - the math function context
    395: -  x  - the value where the function must be evaluated

    397:    Output Parameter:
    398: .  y  - the result of f(x)

    400:    Level: intermediate

    402: .seealso: FNEvaluateDerivative()
    403: @*/
    404: PetscErrorCode FNEvaluateFunction(FN fn,PetscScalar x,PetscScalar *y)
    405: {

    412:   if (!((PetscObject)fn)->type_name) {
    413:     FNSetType(fn,FNRATIONAL);
    414:   }
    415:   (*fn->ops->evaluatefunction)(fn,x,y);
    416:   return(0);
    417: }

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

    424:    Logically Collective on FN

    426:    Input Parameters:
    427: +  fn - the math function context
    428: -  x  - the value where the derivative must be evaluated

    430:    Output Parameter:
    431: .  y  - the result of f'(x)

    433:    Level: intermediate

    435: .seealso: FNEvaluateFunction()
    436: @*/
    437: PetscErrorCode FNEvaluateDerivative(FN fn,PetscScalar x,PetscScalar *y)
    438: {

    445:   if (!((PetscObject)fn)->type_name) {
    446:     FNSetType(fn,FNRATIONAL);
    447:   }
    448:   (*fn->ops->evaluatederivative)(fn,x,y);
    449:   return(0);
    450: }

    454: /*@
    455:    FNSetFromOptions - Sets FN options from the options database.

    457:    Collective on FN

    459:    Input Parameters:
    460: .  fn - the math function context

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

    465:    Level: beginner
    466: @*/
    467: PetscErrorCode FNSetFromOptions(FN fn)
    468: {

    473:   if (!FNRegisterAllCalled) { FNRegisterAll(); }
    474:   /* Set default type (we do not allow changing it with -fn_type) */
    475:   if (!((PetscObject)fn)->type_name) {
    476:     FNSetType(fn,FNRATIONAL);
    477:   }
    478:   PetscObjectOptionsBegin((PetscObject)fn);
    479:     PetscObjectProcessOptionsHandlers((PetscObject)fn);
    480:   PetscOptionsEnd();
    481:   return(0);
    482: }

    486: /*@C
    487:    FNView - Prints the FN data structure.

    489:    Collective on FN

    491:    Input Parameters:
    492: +  fn - the math function context
    493: -  viewer - optional visualization context

    495:    Note:
    496:    The available visualization contexts include
    497: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
    498: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
    499:          output where only the first processor opens
    500:          the file.  All other processors send their
    501:          data to the first processor to print.

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

    506:    Level: beginner
    507: @*/
    508: PetscErrorCode FNView(FN fn,PetscViewer viewer)
    509: {
    510:   PetscBool      isascii;

    515:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)fn));
    518:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    519:   if (isascii) {
    520:     PetscObjectPrintClassNamePrefixType((PetscObject)fn,viewer,"FN Object");
    521:     if (fn->ops->view) {
    522:       PetscViewerASCIIPushTab(viewer);
    523:       (*fn->ops->view)(fn,viewer);
    524:       PetscViewerASCIIPopTab(viewer);
    525:     }
    526:   }
    527:   return(0);
    528: }

    532: /*@C
    533:    FNDestroy - Destroys FN context that was created with FNCreate().

    535:    Collective on FN

    537:    Input Parameter:
    538: .  fn - the math function context

    540:    Level: beginner

    542: .seealso: FNCreate()
    543: @*/
    544: PetscErrorCode FNDestroy(FN *fn)
    545: {

    549:   if (!*fn) return(0);
    551:   if (--((PetscObject)(*fn))->refct > 0) { *fn = 0; return(0); }
    552:   PetscFree((*fn)->alpha);
    553:   PetscFree((*fn)->beta);
    554:   PetscHeaderDestroy(fn);
    555:   return(0);
    556: }

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

    563:    Not collective

    565:    Input Parameters:
    566: +  name - name of a new user-defined FN
    567: -  function - routine to create context

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

    572:    Level: advanced

    574: .seealso: FNRegisterAll()
    575: @*/
    576: PetscErrorCode FNRegister(const char *name,PetscErrorCode (*function)(FN))
    577: {

    581:   PetscFunctionListAdd(&FNList,name,function);
    582:   return(0);
    583: }

    585: PETSC_EXTERN PetscErrorCode FNCreate_Rational(FN);
    586: PETSC_EXTERN PetscErrorCode FNCreate_Exp(FN);

    590: /*@C
    591:    FNRegisterAll - Registers all of the math functions in the FN package.

    593:    Not Collective

    595:    Level: advanced
    596: @*/
    597: PetscErrorCode FNRegisterAll(void)
    598: {

    602:   FNRegisterAllCalled = PETSC_TRUE;
    603:   FNRegister(FNRATIONAL,FNCreate_Rational);
    604:   FNRegister(FNEXP,FNCreate_Exp);
    605:   return(0);
    606: }