Actual source code: shell.c
slepc-3.21.1 2024-04-26
Report Typos and Errors

      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 a shell ST

     28:    Not Collective

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

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

     36:    Level: advanced

     38:    Notes:
     39:    This routine is intended for use within various shell routines

     41: .seealso: STShellSetContext()
     42: @*/
     43: PetscErrorCode STShellGetContext(ST st,void *ctx)
     44: {
     45:   PetscBool      flg;

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

     56: /*@
     57:    STShellSetContext - Sets the context for a shell ST

     59:    Logically Collective

     61:    Input Parameters:
     62: +  st - the shell ST
     63: -  ctx - the context

     65:    Level: advanced

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

     72: .seealso: STShellGetContext()
     73: @*/
     74: PetscErrorCode STShellSetContext(ST st,void *ctx)
     75: {
     76:   ST_SHELL       *shell = (ST_SHELL*)st->data;
     77:   PetscBool      flg;

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

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

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

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

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

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

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

    148: static PetscErrorCode STBackTransform_Shell(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
    149: {
    150:   ST_SHELL       *shell = (ST_SHELL*)st->data;

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

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

    164:   PetscFunctionBegin;
    165:   *is = shell->backtransform? PETSC_TRUE: PETSC_FALSE;
    166:   PetscFunctionReturn(PETSC_SUCCESS);
    167: }

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

    180: static PetscErrorCode STShellSetApply_Shell(ST st,PetscErrorCode (*apply)(ST,Vec,Vec))
    181: {
    182:   ST_SHELL *shell = (ST_SHELL*)st->data;

    184:   PetscFunctionBegin;
    185:   shell->apply = apply;
    186:   PetscFunctionReturn(PETSC_SUCCESS);
    187: }

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

    193:    Logically Collective

    195:    Input Parameters:
    196: +  st    - the spectral transformation context
    197: -  apply - the application-provided transformation routine

    199:    Calling sequence of apply:
    200: $  PetscErrorCode apply(ST st,Vec xin,Vec xout)
    201: +  st   - the spectral transformation context
    202: .  xin  - input vector
    203: -  xout - output vector

    205:    Level: advanced

    207: .seealso: STShellSetBackTransform(), STShellSetApplyTranspose(), STShellSetApplyHermitianTranspose()
    208: @*/
    209: PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(ST st,Vec xin,Vec xout))
    210: {
    211:   PetscFunctionBegin;
    213:   PetscTryMethod(st,"STShellSetApply_C",(ST,PetscErrorCode (*)(ST,Vec,Vec)),(st,apply));
    214:   PetscFunctionReturn(PETSC_SUCCESS);
    215: }

    217: static PetscErrorCode STShellSetApplyTranspose_Shell(ST st,PetscErrorCode (*applytrans)(ST,Vec,Vec))
    218: {
    219:   ST_SHELL *shell = (ST_SHELL*)st->data;

    221:   PetscFunctionBegin;
    222:   shell->applytrans = applytrans;
    223:   PetscFunctionReturn(PETSC_SUCCESS);
    224: }

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

    230:    Logically Collective

    232:    Input Parameters:
    233: +  st    - the spectral transformation context
    234: -  applytrans - the application-provided transformation routine

    236:    Calling sequence of applytrans:
    237: $  PetscErrorCode applytrans(ST st,Vec xin,Vec xout)
    238: +  st   - the spectral transformation context
    239: .  xin  - input vector
    240: -  xout - output vector

    242:    Level: advanced

    244: .seealso: STShellSetApply(), STShellSetBackTransform()
    245: @*/
    246: PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(ST st,Vec xin,Vec xout))
    247: {
    248:   PetscFunctionBegin;
    250:   PetscTryMethod(st,"STShellSetApplyTranspose_C",(ST,PetscErrorCode (*)(ST,Vec,Vec)),(st,applytrans));
    251:   PetscFunctionReturn(PETSC_SUCCESS);
    252: }

    254: #if defined(PETSC_USE_COMPLEX)
    255: static PetscErrorCode STShellSetApplyHermitianTranspose_Shell(ST st,PetscErrorCode (*applyhermtrans)(ST,Vec,Vec))
    256: {
    257:   ST_SHELL *shell = (ST_SHELL*)st->data;

    259:   PetscFunctionBegin;
    260:   shell->applyhermtrans = applyhermtrans;
    261:   PetscFunctionReturn(PETSC_SUCCESS);
    262: }
    263: #endif

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

    269:    Logically Collective

    271:    Input Parameters:
    272: +  st    - the spectral transformation context
    273: -  applyhermtrans - the application-provided transformation routine

    275:    Calling sequence of applyhermtrans:
    276: $  PetscErrorCode applyhermtrans(ST st,Vec xin,Vec xout)
    277: +  st   - the spectral transformation context
    278: .  xin  - input vector
    279: -  xout - output vector

    281:    Note:
    282:    If configured with real scalars, this function has the same effect as STShellSetApplyTranspose(),
    283:    so no need to call both.

    285:    Level: advanced

    287: .seealso: STShellSetApply(), STShellSetApplyTranspose(), STShellSetBackTransform()
    288: @*/
    289: PetscErrorCode STShellSetApplyHermitianTranspose(ST st,PetscErrorCode (*applyhermtrans)(ST st,Vec xin,Vec xout))
    290: {
    291:   PetscFunctionBegin;
    293:   PetscTryMethod(st,"STShellSetApplyHermitianTranspose_C",(ST,PetscErrorCode (*)(ST,Vec,Vec)),(st,applyhermtrans));
    294:   PetscFunctionReturn(PETSC_SUCCESS);
    295: }

    297: static PetscErrorCode STShellSetBackTransform_Shell(ST st,PetscErrorCode (*backtr)(ST,PetscInt,PetscScalar*,PetscScalar*))
    298: {
    299:   ST_SHELL *shell = (ST_SHELL*)st->data;

    301:   PetscFunctionBegin;
    302:   shell->backtransform = backtr;
    303:   PetscFunctionReturn(PETSC_SUCCESS);
    304: }

    306: /*@C
    307:    STShellSetBackTransform - Sets the routine to be called after the
    308:    eigensolution process has finished in order to transform back the
    309:    computed eigenvalues.

    311:    Logically Collective

    313:    Input Parameters:
    314: +  st     - the spectral transformation context
    315: -  backtr - the application-provided backtransform routine

    317:    Calling sequence of backtr:
    318: $  PetscErrorCode backtr(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
    319: +  st   - the spectral transformation context
    320: .  n    - number of eigenvalues to be backtransformed
    321: .  eigr - pointer ot the real parts of the eigenvalues to transform back
    322: -  eigi - pointer ot the imaginary parts

    324:    Level: advanced

    326: .seealso: STShellSetApply(), STShellSetApplyTranspose()
    327: @*/
    328: PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi))
    329: {
    330:   PetscFunctionBegin;
    332:   PetscTryMethod(st,"STShellSetBackTransform_C",(ST,PetscErrorCode (*)(ST,PetscInt,PetscScalar*,PetscScalar*)),(st,backtr));
    333:   PetscFunctionReturn(PETSC_SUCCESS);
    334: }

    336: /*MC
    337:    STSHELL - User-defined spectral transformation via callback functions
    338:    for the application of the operator to a vector and (optionally) the
    339:    backtransform operation.

    341:    Level: advanced

    343:    Usage:
    344: $             extern PetscErrorCode (*apply)(void*,Vec,Vec);
    345: $             extern PetscErrorCode (*applytrans)(void*,Vec,Vec);
    346: $             extern PetscErrorCode (*applyht)(void*,Vec,Vec);
    347: $             extern PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*);
    348: $
    349: $             STCreate(comm,&st);
    350: $             STSetType(st,STSHELL);
    351: $             STShellSetContext(st,ctx);
    352: $             STShellSetApply(st,apply);
    353: $             STShellSetApplyTranspose(st,applytrans);        (optional)
    354: $             STShellSetApplyHermitianTranspose(st,applyht);  (optional, only in complex scalars)
    355: $             STShellSetBackTransform(st,backtr);             (optional)

    357: M*/

    359: SLEPC_EXTERN PetscErrorCode STCreate_Shell(ST st)
    360: {
    361:   ST_SHELL       *ctx;

    363:   PetscFunctionBegin;
    364:   PetscCall(PetscNew(&ctx));
    365:   st->data = (void*)ctx;

    367:   st->usesksp = PETSC_FALSE;

    369:   st->ops->apply           = STApply_Shell;
    370:   st->ops->applytrans      = STApplyTranspose_Shell;
    371: #if defined(PETSC_USE_COMPLEX)
    372:   st->ops->applyhermtrans  = STApplyHermitianTranspose_Shell;
    373: #else
    374:   st->ops->applyhermtrans  = STApplyTranspose_Shell;
    375: #endif
    376:   st->ops->backtransform   = STBackTransform_Shell;
    377:   st->ops->destroy         = STDestroy_Shell;

    379:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApply_C",STShellSetApply_Shell));
    380:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyTranspose_C",STShellSetApplyTranspose_Shell));
    381: #if defined(PETSC_USE_COMPLEX)
    382:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyHermitianTranspose_C",STShellSetApplyHermitianTranspose_Shell));
    383: #else
    384:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyHermitianTranspose_C",STShellSetApplyTranspose_Shell));
    385: #endif
    386:   PetscCall(PetscObjectComposeFunction((PetscObject)st,"STShellSetBackTransform_C",STShellSetBackTransform_Shell));
    387:   PetscFunctionReturn(PETSC_SUCCESS);
    388: }