Actual source code: shell.c

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.
      7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: */
     10: /*
     11:    This provides a simple shell interface for programmers to create
     12:    their own spectral transformations without writing much interface code
     13: */

     15: #include <slepc/private/stimpl.h>

     17: typedef struct {
     18:   void           *ctx;                       /* user provided context */
     19:   PetscErrorCode (*apply)(ST,Vec,Vec);
     20:   PetscErrorCode (*applytrans)(ST,Vec,Vec);
     21:   PetscErrorCode (*applyhermtrans)(ST,Vec,Vec);
     22:   PetscErrorCode (*backtransform)(ST,PetscInt n,PetscScalar*,PetscScalar*);
     23: } ST_SHELL;

     25: /*@C
     26:    STShellGetContext - Returns the user-provided context associated with an `STSHELL`.

     28:    Not Collective

     30:    Input Parameter:
     31: .  st - spectral transformation context

     33:    Output Parameter:
     34: .  ctx - the user provided context

     36:    Level: advanced

     38: .seealso: [](ch:st), `STSHELL`, `STShellSetContext()`
     39: @*/
     40: PetscErrorCode STShellGetContext(ST st,void *ctx)
     41: {
     42:   PetscBool      flg;

     44:   PetscFunctionBegin;
     46:   PetscAssertPointer(ctx,2);
     47:   PetscCall(PetscObjectTypeCompare((PetscObject)st,STSHELL,&flg));
     48:   if (!flg) *(void**)ctx = NULL;
     49:   else      *(void**)ctx = ((ST_SHELL*)st->data)->ctx;
     50:   PetscFunctionReturn(PETSC_SUCCESS);
     51: }

     53: /*@
     54:    STShellSetContext - Sets the user-defined context for an `STSHELL`.

     56:    Logically Collective

     58:    Input Parameters:
     59: +  st - the shell ST
     60: -  ctx - the context

     62:    Level: advanced

     64:    Fortran Notes:
     65:    To use this from Fortran you must write a Fortran interface definition
     66:    for this function that tells Fortran the Fortran derived data type that
     67:    you are passing in as the `ctx` argument.

     69: .seealso: [](ch:st), `STSHELL`, `STShellGetContext()`
     70: @*/
     71: PetscErrorCode STShellSetContext(ST st,void *ctx)
     72: {
     73:   ST_SHELL       *shell = (ST_SHELL*)st->data;
     74:   PetscBool      flg;

     76:   PetscFunctionBegin;
     78:   PetscCall(PetscObjectTypeCompare((PetscObject)st,STSHELL,&flg));
     79:   if (flg) shell->ctx = ctx;
     80:   PetscFunctionReturn(PETSC_SUCCESS);
     81: }

     83: static PetscErrorCode STApply_Shell(ST st,Vec x,Vec y)
     84: {
     85:   ST_SHELL         *shell = (ST_SHELL*)st->data;
     86:   PetscObjectState instate,outstate;

     88:   PetscFunctionBegin;
     89:   PetscCheck(shell->apply,PetscObjectComm((PetscObject)st),PETSC_ERR_USER,"No apply() routine provided to Shell ST");
     90:   PetscCall(VecGetState(y,&instate));
     91:   PetscCallBack("STSHELL user function apply()",(*shell->apply)(st,x,y));
     92:   PetscCall(VecGetState(y,&outstate));
     93:   if (instate == outstate) {
     94:     /* user forgot to increase the state of the output vector */
     95:     PetscCall(PetscObjectStateIncrease((PetscObject)y));
     96:   }
     97:   PetscFunctionReturn(PETSC_SUCCESS);
     98: }

    100: static PetscErrorCode STApplyTranspose_Shell(ST st,Vec x,Vec y)
    101: {
    102:   ST_SHELL         *shell = (ST_SHELL*)st->data;
    103:   PetscObjectState instate,outstate;

    105:   PetscFunctionBegin;
    106:   PetscCheck(shell->applytrans,PetscObjectComm((PetscObject)st),PETSC_ERR_USER,"No applytrans() routine provided to Shell ST");
    107:   PetscCall(VecGetState(y,&instate));
    108:   PetscCallBack("STSHELL user function applytrans()",(*shell->applytrans)(st,x,y));
    109:   PetscCall(VecGetState(y,&outstate));
    110:   if (instate == outstate) {
    111:     /* user forgot to increase the state of the output vector */
    112:     PetscCall(PetscObjectStateIncrease((PetscObject)y));
    113:   }
    114:   PetscFunctionReturn(PETSC_SUCCESS);
    115: }

    117: #if defined(PETSC_USE_COMPLEX)
    118: static PetscErrorCode STApplyHermitianTranspose_Shell(ST st,Vec x,Vec y)
    119: {
    120:   ST_SHELL         *shell = (ST_SHELL*)st->data;
    121:   PetscObjectState instate,outstate;
    122:   Vec              w;

    124:   PetscFunctionBegin;
    125:   if (shell->applyhermtrans) {
    126:     PetscCall(VecGetState(y,&instate));
    127:     PetscCallBack("STSHELL user function applyhermtrans()",(*shell->applyhermtrans)(st,x,y));
    128:     PetscCall(VecGetState(y,&outstate));
    129:     if (instate == outstate) {
    130:       /* user forgot to increase the state of the output vector */
    131:       PetscCall(PetscObjectStateIncrease((PetscObject)y));
    132:     }
    133:   } else {
    134:     PetscCall(VecDuplicate(x,&w));
    135:     PetscCall(VecCopy(x,w));
    136:     PetscCall(VecConjugate(w));
    137:     PetscCall(STApplyTranspose_Shell(st,w,y));
    138:     PetscCall(VecDestroy(&w));
    139:     PetscCall(VecConjugate(y));
    140:   }
    141:   PetscFunctionReturn(PETSC_SUCCESS);
    142: }
    143: #endif

    145: static PetscErrorCode STBackTransform_Shell(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
    146: {
    147:   ST_SHELL       *shell = (ST_SHELL*)st->data;

    149:   PetscFunctionBegin;
    150:   if (shell->backtransform) PetscCallBack("STSHELL user function backtransform()",(*shell->backtransform)(st,n,eigr,eigi));
    151:   PetscFunctionReturn(PETSC_SUCCESS);
    152: }

    154: /*
    155:    STIsInjective_Shell - Check if the user has provided the backtransform operation.
    156: */
    157: PetscErrorCode STIsInjective_Shell(ST st,PetscBool* is)
    158: {
    159:   ST_SHELL *shell = (ST_SHELL*)st->data;

    161:   PetscFunctionBegin;
    162:   *is = shell->backtransform? PETSC_TRUE: PETSC_FALSE;
    163:   PetscFunctionReturn(PETSC_SUCCESS);
    164: }

    166: static PetscErrorCode STDestroy_Shell(ST st)
    167: {
    168:   PetscFunctionBegin;
    169:   PetscCall(PetscFree(st->data));
    170:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApply_C",NULL));
    171:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyTranspose_C",NULL));
    172:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyHermitianTranspose_C",NULL));
    173:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetBackTransform_C",NULL));
    174:   PetscFunctionReturn(PETSC_SUCCESS);
    175: }

    177: static PetscErrorCode STShellSetApply_Shell(ST st,STShellApplyFn *apply)
    178: {
    179:   ST_SHELL *shell = (ST_SHELL*)st->data;

    181:   PetscFunctionBegin;
    182:   shell->apply = apply;
    183:   PetscFunctionReturn(PETSC_SUCCESS);
    184: }

    186: /*@C
    187:    STShellSetApply - Sets routine to use as the application of the
    188:    operator to a vector in the user-defined spectral transformation.

    190:    Logically Collective

    192:    Input Parameters:
    193: +  st    - the spectral transformation context
    194: -  apply - the application-provided transformation routine

    196:    Level: advanced

    198: .seealso: [](ch:st), `STSHELL`, `STShellSetBackTransform()`, `STShellSetApplyTranspose()`, `STShellSetApplyHermitianTranspose()`
    199: @*/
    200: PetscErrorCode STShellSetApply(ST st,STShellApplyFn *apply)
    201: {
    202:   PetscFunctionBegin;
    204:   PetscTryMethod(st,"STShellSetApply_C",(ST,STShellApplyFn*),(st,apply));
    205:   PetscFunctionReturn(PETSC_SUCCESS);
    206: }

    208: static PetscErrorCode STShellSetApplyTranspose_Shell(ST st,STShellApplyTransposeFn *applytrans)
    209: {
    210:   ST_SHELL *shell = (ST_SHELL*)st->data;

    212:   PetscFunctionBegin;
    213:   shell->applytrans = applytrans;
    214:   PetscFunctionReturn(PETSC_SUCCESS);
    215: }

    217: /*@C
    218:    STShellSetApplyTranspose - Sets routine to use as the application of the
    219:    transposed operator to a vector in the user-defined spectral transformation.

    221:    Logically Collective

    223:    Input Parameters:
    224: +  st    - the spectral transformation context
    225: -  applytrans - the application-provided transformation routine

    227:    Level: advanced

    229: .seealso: [](ch:st), `STSHELL`, `STShellSetApply()`, `STShellSetBackTransform()`
    230: @*/
    231: PetscErrorCode STShellSetApplyTranspose(ST st,STShellApplyTransposeFn *applytrans)
    232: {
    233:   PetscFunctionBegin;
    235:   PetscTryMethod(st,"STShellSetApplyTranspose_C",(ST,STShellApplyTransposeFn*),(st,applytrans));
    236:   PetscFunctionReturn(PETSC_SUCCESS);
    237: }

    239: #if defined(PETSC_USE_COMPLEX)
    240: static PetscErrorCode STShellSetApplyHermitianTranspose_Shell(ST st,STShellApplyHermitianTransposeFn *applyhermtrans)
    241: {
    242:   ST_SHELL *shell = (ST_SHELL*)st->data;

    244:   PetscFunctionBegin;
    245:   shell->applyhermtrans = applyhermtrans;
    246:   PetscFunctionReturn(PETSC_SUCCESS);
    247: }
    248: #endif

    250: /*@C
    251:    STShellSetApplyHermitianTranspose - Sets routine to use as the application of the
    252:    conjugate-transposed operator to a vector in the user-defined spectral transformation.

    254:    Logically Collective

    256:    Input Parameters:
    257: +  st    - the spectral transformation context
    258: -  applyhermtrans - the application-provided transformation routine

    260:    Note:
    261:    If configured with real scalars, this function has the same effect as `STShellSetApplyTranspose()`,
    262:    so no need to call both.

    264:    Level: advanced

    266: .seealso: [](ch:st), `STSHELL`, `STShellSetApply()`, `STShellSetApplyTranspose()`, `STShellSetBackTransform()`
    267: @*/
    268: PetscErrorCode STShellSetApplyHermitianTranspose(ST st,STShellApplyHermitianTransposeFn *applyhermtrans)
    269: {
    270:   PetscFunctionBegin;
    272:   PetscTryMethod(st,"STShellSetApplyHermitianTranspose_C",(ST,STShellApplyHermitianTransposeFn*),(st,applyhermtrans));
    273:   PetscFunctionReturn(PETSC_SUCCESS);
    274: }

    276: static PetscErrorCode STShellSetBackTransform_Shell(ST st,STShellBackTransformFn *backtr)
    277: {
    278:   ST_SHELL *shell = (ST_SHELL*)st->data;

    280:   PetscFunctionBegin;
    281:   shell->backtransform = backtr;
    282:   PetscFunctionReturn(PETSC_SUCCESS);
    283: }

    285: /*@C
    286:    STShellSetBackTransform - Sets the routine to be called after the
    287:    eigensolution process has finished in order to transform back the
    288:    computed eigenvalues.

    290:    Logically Collective

    292:    Input Parameters:
    293: +  st     - the spectral transformation context
    294: -  backtr - the application-provided backtransform routine

    296:    Level: advanced

    298: .seealso: [](ch:st), `STSHELL`, `STShellSetApply()`, `STShellSetApplyTranspose()`
    299: @*/
    300: PetscErrorCode STShellSetBackTransform(ST st,STShellBackTransformFn *backtr)
    301: {
    302:   PetscFunctionBegin;
    304:   PetscTryMethod(st,"STShellSetBackTransform_C",(ST,STShellBackTransformFn*),(st,backtr));
    305:   PetscFunctionReturn(PETSC_SUCCESS);
    306: }

    308: /*MC
    309:    STSHELL - STSHELL = "shell" - User-defined spectral transformation via callback
    310:    functions for the application of the operator to a vector and (optionally) the
    311:    backtransform operation.

    313:    Level: beginner

    315:    Note:
    316:    In order to define a `shell` spectral transformation, the user has to provide
    317:    the `apply` operation via `STShellSetApply()` and related functions, and
    318:    optionally a `backtransform` operation via `STShellSetBackTransform()`, and
    319:    in some cases a user-defined context containing relevant data via
    320:    `STShellSetContext()`.

    322: .seealso: [](ch:st), `ST`, `STType`, `STSetType()`, `STShellSetApply()`, `STShellSetBackTransform()`, `STShellSetContext()`
    323: M*/

    325: SLEPC_EXTERN PetscErrorCode STCreate_Shell(ST st)
    326: {
    327:   ST_SHELL       *ctx;

    329:   PetscFunctionBegin;
    330:   PetscCall(PetscNew(&ctx));
    331:   st->data = (void*)ctx;

    333:   st->usesksp = PETSC_FALSE;

    335:   st->ops->apply           = STApply_Shell;
    336:   st->ops->applytrans      = STApplyTranspose_Shell;
    337: #if defined(PETSC_USE_COMPLEX)
    338:   st->ops->applyhermtrans  = STApplyHermitianTranspose_Shell;
    339: #else
    340:   st->ops->applyhermtrans  = STApplyTranspose_Shell;
    341: #endif
    342:   st->ops->backtransform   = STBackTransform_Shell;
    343:   st->ops->destroy         = STDestroy_Shell;

    345:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApply_C",STShellSetApply_Shell));
    346:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyTranspose_C",STShellSetApplyTranspose_Shell));
    347: #if defined(PETSC_USE_COMPLEX)
    348:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyHermitianTranspose_C",STShellSetApplyHermitianTranspose_Shell));
    349: #else
    350:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyHermitianTranspose_C",STShellSetApplyTranspose_Shell));
    351: #endif
    352:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetBackTransform_C",STShellSetBackTransform_Shell));
    353:   PetscFunctionReturn(PETSC_SUCCESS);
    354: }