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

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

      1: /*
      2:    Phi functions
      3:       phi_0(x) = exp(x)
      4:       phi_1(x) = (exp(x)-1)/x
      5:       phi_k(x) = (phi_{k-1}(x)-1/(k-1)!)/x

      7:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      8:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      9:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

     11:    This file is part of SLEPc.

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

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

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

     27: #include <slepc/private/fnimpl.h>      /*I "slepcfn.h" I*/

     29: typedef struct {
     30:   PetscInt k;    /* index of the phi-function, defaults to k=1 */
     31: } FN_PHI;

     33: const static PetscReal rfactorial[] = { 1, 1, 0.5, 1.0/6, 1.0/24, 1.0/120, 1.0/720, 1.0/5040, 1.0/40320, 1.0/362880 };

     35: static void PhiFunction(PetscScalar x,PetscScalar *y,PetscInt k)
     36: {
     37:   PetscScalar phi;

     39:   if (!k) *y = PetscExpScalar(x);
     40:   else if (k==1) *y = (PetscExpScalar(x)-1.0)/x;
     41:   else {
     42:     /* phi_k(x) = (phi_{k-1}(x)-1/(k-1)!)/x */
     43:     PhiFunction(x,&phi,k-1);
     44:     *y = (phi-rfactorial[k-1])/x;
     45:   }
     46: }

     50: PetscErrorCode FNEvaluateFunction_Phi(FN fn,PetscScalar x,PetscScalar *y)
     51: {
     52:   FN_PHI *ctx = (FN_PHI*)fn->data;

     55:   PhiFunction(x,y,ctx->k);
     56:   return(0);
     57: }

     59: static void PhiDerivative(PetscScalar x,PetscScalar *y,PetscInt k)
     60: {
     61:   PetscScalar der,phi;

     63:   if (!k) *y = PetscExpScalar(x);
     64:   else if (k==1) {
     65:     der = PetscExpScalar(x);
     66:     phi = (der-1.0)/x;
     67:     *y = (der-phi)/x;
     68:   } else {
     69:     PhiDerivative(x,&der,k-1);
     70:     PhiFunction(x,&phi,k);
     71:     *y = (der-phi)/x;
     72:   }
     73: }

     77: PetscErrorCode FNEvaluateDerivative_Phi(FN fn,PetscScalar x,PetscScalar *y)
     78: {
     79:   FN_PHI *ctx = (FN_PHI*)fn->data;

     82:   PhiDerivative(x,y,ctx->k);
     83:   return(0);
     84: }

     88: static PetscErrorCode FNPhiSetIndex_Phi(FN fn,PetscInt k)
     89: {
     90:   FN_PHI *ctx = (FN_PHI*)fn->data;

     93:   ctx->k = k;
     94:   return(0);
     95: }

     99: /*@
    100:    FNPhiSetIndex - Sets the index of the phi-function.

    102:    Logically Collective on FN

    104:    Input Parameters:
    105: +  fn - the math function context
    106: -  k  - the index

    108:    Notes:
    109:    The phi-functions are defined as follows. The default is k=1.
    110: .vb
    111:       phi_0(x) = exp(x)
    112:       phi_1(x) = (exp(x)-1)/x
    113:       phi_k(x) = (phi_{k-1}(x)-1/(k-1)!)/x
    114: .ve

    116:    Level: intermediate

    118: .seealso: FNPhiGetIndex()
    119: @*/
    120: PetscErrorCode FNPhiSetIndex(FN fn,PetscInt k)
    121: {

    127:   if (k<0) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Index cannot be negative");
    128:   if (k>10) SETERRQ(PetscObjectComm((PetscObject)fn),PETSC_ERR_ARG_OUTOFRANGE,"Only implemented for k<=10");
    129:   PetscTryMethod(fn,"FNPhiSetIndex_C",(FN,PetscInt),(fn,k));
    130:   return(0);
    131: }

    135: static PetscErrorCode FNPhiGetIndex_Phi(FN fn,PetscInt *k)
    136: {
    137:   FN_PHI *ctx = (FN_PHI*)fn->data;

    140:   *k = ctx->k;
    141:   return(0);
    142: }

    146: /*@
    147:    FNPhiGetIndex - Gets the index of the phi-function.

    149:    Not Collective

    151:    Input Parameter:
    152: .  fn - the math function context

    154:    Output Parameter:
    155: .  k  - the index

    157:    Level: intermediate

    159: .seealso: FNPhiSetIndex()
    160: @*/
    161: PetscErrorCode FNPhiGetIndex(FN fn,PetscInt *k)
    162: {

    168:   PetscTryMethod(fn,"FNPhiGetIndex_C",(FN,PetscInt*),(fn,k));
    169:   return(0);
    170: }

    174: PetscErrorCode FNView_Phi(FN fn,PetscViewer viewer)
    175: {
    177:   FN_PHI         *ctx = (FN_PHI*)fn->data;
    178:   PetscBool      isascii;
    179:   char           str[50],strx[50];

    182:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    183:   if (isascii) {
    184:     PetscViewerASCIIPrintf(viewer,"  Phi_%d: ",ctx->k);
    185:     if (fn->beta!=(PetscScalar)1.0) {
    186:       SlepcSNPrintfScalar(str,50,fn->beta,PETSC_TRUE);
    187:       PetscViewerASCIIPrintf(viewer,"%s*",str);
    188:     }
    189:     if (fn->alpha==(PetscScalar)1.0) {
    190:       PetscSNPrintf(strx,50,"x");
    191:     } else {
    192:       SlepcSNPrintfScalar(str,50,fn->alpha,PETSC_TRUE);
    193:       PetscSNPrintf(strx,50,"(%s*x)",str);
    194:     }
    195:     if (!ctx->k) {
    196:       PetscViewerASCIIPrintf(viewer,"exp(%s)\n",strx);
    197:     } else if (ctx->k==1) {
    198:       PetscViewerASCIIPrintf(viewer,"(exp(%s)-1)/%s\n",strx,strx);
    199:     } else {
    200:       PetscViewerASCIIPrintf(viewer,"(phi_%d(%s)-1/%d!)/%s\n",ctx->k-1,strx,ctx->k-1,strx);
    201:     }
    202:   }
    203:   return(0);
    204: }

    208: PetscErrorCode FNSetFromOptions_Phi(PetscOptions *PetscOptionsObject,FN fn)
    209: {
    211:   FN_PHI         *ctx = (FN_PHI*)fn->data;
    212:   PetscInt       k;
    213:   PetscBool      flag;

    216:   PetscOptionsHead(PetscOptionsObject,"FN Phi Options");
    217:     PetscOptionsInt("-fn_phi_index","Index of the phi-function","FNPhiSetIndex",ctx->k,&k,&flag);
    218:     if (flag) {
    219:       FNPhiSetIndex(fn,k);
    220:     }
    221:   PetscOptionsTail();
    222:   return(0);
    223: }

    227: PetscErrorCode FNDuplicate_Phi(FN fn,MPI_Comm comm,FN *newfn)
    228: {
    230:   FN_PHI         *ctx = (FN_PHI*)fn->data,*ctx2;

    233:   PetscNewLog(*newfn,&ctx2);
    234:   (*newfn)->data = (void*)ctx2;
    235:   ctx2->k = ctx->k;
    236:   return(0);
    237: }

    241: PetscErrorCode FNDestroy_Phi(FN fn)
    242: {

    246:   PetscFree(fn->data);
    247:   PetscObjectComposeFunction((PetscObject)fn,"FNPhiSetIndex_C",NULL);
    248:   PetscObjectComposeFunction((PetscObject)fn,"FNPhiGetIndex_C",NULL);
    249:   return(0);
    250: }

    254: PETSC_EXTERN PetscErrorCode FNCreate_Phi(FN fn)
    255: {
    257:   FN_PHI         *ctx;

    260:   PetscNewLog(fn,&ctx);
    261:   fn->data = (void*)ctx;
    262:   ctx->k   = 1;

    264:   fn->ops->evaluatefunction    = FNEvaluateFunction_Phi;
    265:   fn->ops->evaluatederivative  = FNEvaluateDerivative_Phi;
    266:   fn->ops->setfromoptions      = FNSetFromOptions_Phi;
    267:   fn->ops->view                = FNView_Phi;
    268:   fn->ops->duplicate           = FNDuplicate_Phi;
    269:   fn->ops->destroy             = FNDestroy_Phi;
    270:   PetscObjectComposeFunction((PetscObject)fn,"FNPhiSetIndex_C",FNPhiSetIndex_Phi);
    271:   PetscObjectComposeFunction((PetscObject)fn,"FNPhiGetIndex_C",FNPhiGetIndex_Phi);
    272:   return(0);
    273: }