Actual source code: shell.c

slepc-3.16.1 2021-11-17
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-2021, 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 (*backtransform)(ST,PetscInt n,PetscScalar*,PetscScalar*);
 22: } ST_SHELL;

 24: /*@C
 25:    STShellGetContext - Returns the user-provided context associated with a shell ST

 27:    Not Collective

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

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

 35:    Level: advanced

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

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

 50:   PetscObjectTypeCompare((PetscObject)st,STSHELL,&flg);
 51:   if (!flg) *(void**)ctx = NULL;
 52:   else      *(void**)ctx = ((ST_SHELL*)(st->data))->ctx;
 53:   return(0);
 54: }

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

 59:    Logically Collective on st

 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;
 78:   PetscBool      flg;

 82:   PetscObjectTypeCompare((PetscObject)st,STSHELL,&flg);
 83:   if (flg) shell->ctx = ctx;
 84:   return(0);
 85: }

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

 94:   if (!shell->apply) SETERRQ(PetscObjectComm((PetscObject)st),PETSC_ERR_USER,"No apply() routine provided to Shell ST");
 95:   PetscObjectStateGet((PetscObject)y,&instate);
 96:   PetscStackCall("STSHELL user function apply()",(*shell->apply)(st,x,y);CHKERRQ(ierr));
 97:   PetscObjectStateGet((PetscObject)y,&outstate);
 98:   if (instate == outstate) {
 99:     /* user forgot to increase the state of the output vector */
100:     PetscObjectStateIncrease((PetscObject)y);
101:   }
102:   return(0);
103: }

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

112:   if (!shell->applytrans) SETERRQ(PetscObjectComm((PetscObject)st),PETSC_ERR_USER,"No applytranspose() routine provided to Shell ST");
113:   PetscObjectStateGet((PetscObject)y,&instate);
114:   PetscStackCall("STSHELL user function applytrans()",(*shell->applytrans)(st,x,y);CHKERRQ(ierr));
115:   PetscObjectStateGet((PetscObject)y,&outstate);
116:   if (instate == outstate) {
117:     /* user forgot to increase the state of the output vector */
118:     PetscObjectStateIncrease((PetscObject)y);
119:   }
120:   return(0);
121: }

123: PetscErrorCode STBackTransform_Shell(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
124: {
126:   ST_SHELL       *shell = (ST_SHELL*)st->data;

129:   if (shell->backtransform) PetscStackCall("STSHELL user function backtransform()",(*shell->backtransform)(st,n,eigr,eigi);CHKERRQ(ierr));
130:   return(0);
131: }

133: /*
134:    STIsInjective_Shell - Check if the user has provided the backtransform operation.
135: */
136: PetscErrorCode STIsInjective_Shell(ST st,PetscBool* is)
137: {
138:   ST_SHELL *shell = (ST_SHELL*)st->data;

141:   *is = shell->backtransform? PETSC_TRUE: PETSC_FALSE;
142:   return(0);
143: }

145: PetscErrorCode STDestroy_Shell(ST st)
146: {

150:   PetscFree(st->data);
151:   PetscObjectComposeFunction((PetscObject)st,"STShellSetApply_C",NULL);
152:   PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyTranspose_C",NULL);
153:   PetscObjectComposeFunction((PetscObject)st,"STShellSetBackTransform_C",NULL);
154:   return(0);
155: }

157: static PetscErrorCode STShellSetApply_Shell(ST st,PetscErrorCode (*apply)(ST,Vec,Vec))
158: {
159:   ST_SHELL *shell = (ST_SHELL*)st->data;

162:   shell->apply = apply;
163:   return(0);
164: }

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

170:    Logically Collective on st

172:    Input Parameters:
173: +  st    - the spectral transformation context
174: -  apply - the application-provided transformation routine

176:    Calling sequence of apply:
177: $  PetscErrorCode apply(ST st,Vec xin,Vec xout)

179: +  st   - the spectral transformation context
180: .  xin  - input vector
181: -  xout - output vector

183:    Level: advanced

185: .seealso: STShellSetBackTransform(), STShellSetApplyTranspose()
186: @*/
187: PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(ST,Vec,Vec))
188: {

193:   PetscTryMethod(st,"STShellSetApply_C",(ST,PetscErrorCode (*)(ST,Vec,Vec)),(st,apply));
194:   return(0);
195: }

197: static PetscErrorCode STShellSetApplyTranspose_Shell(ST st,PetscErrorCode (*applytrans)(ST,Vec,Vec))
198: {
199:   ST_SHELL *shell = (ST_SHELL*)st->data;

202:   shell->applytrans = applytrans;
203:   return(0);
204: }

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

210:    Logically Collective on st

212:    Input Parameters:
213: +  st    - the spectral transformation context
214: -  applytrans - the application-provided transformation routine

216:    Calling sequence of applytrans:
217: $  PetscErrorCode applytrans(ST st,Vec xin,Vec xout)

219: +  st   - the spectral transformation context
220: .  xin  - input vector
221: -  xout - output vector

223:    Level: advanced

225: .seealso: STShellSetApply(), STShellSetBackTransform()
226: @*/
227: PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(ST,Vec,Vec))
228: {

233:   PetscTryMethod(st,"STShellSetApplyTranspose_C",(ST,PetscErrorCode (*)(ST,Vec,Vec)),(st,applytrans));
234:   return(0);
235: }

237: static PetscErrorCode STShellSetBackTransform_Shell(ST st,PetscErrorCode (*backtr)(ST,PetscInt,PetscScalar*,PetscScalar*))
238: {
239:   ST_SHELL *shell = (ST_SHELL*)st->data;

242:   shell->backtransform = backtr;
243:   return(0);
244: }

246: /*@C
247:    STShellSetBackTransform - Sets the routine to be called after the
248:    eigensolution process has finished in order to transform back the
249:    computed eigenvalues.

251:    Logically Collective on st

253:    Input Parameters:
254: +  st     - the spectral transformation context
255: -  backtr - the application-provided backtransform routine

257:    Calling sequence of backtr:
258: $  PetscErrorCode backtr(ST st,PetscScalar *eigr,PetscScalar *eigi)

260: +  st   - the spectral transformation context
261: .  eigr - pointer ot the real part of the eigenvalue to transform back
262: -  eigi - pointer ot the imaginary part

264:    Level: advanced

266: .seealso: STShellSetApply(), STShellSetApplyTranspose()
267: @*/
268: PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(ST,PetscInt,PetscScalar*,PetscScalar*))
269: {

274:   PetscTryMethod(st,"STShellSetBackTransform_C",(ST,PetscErrorCode (*)(ST,PetscInt,PetscScalar*,PetscScalar*)),(st,backtr));
275:   return(0);
276: }

278: /*MC
279:    STSHELL - User-defined spectral transformation via callback functions
280:    for the application of the operator to a vector and (optionally) the
281:    backtransform operation.

283:    Level: advanced

285:    Usage:
286: $             extern PetscErrorCode (*apply)(void*,Vec,Vec);
287: $             extern PetscErrorCode (*applytrans)(void*,Vec,Vec);
288: $             extern PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*);
289: $
290: $             STCreate(comm,&st);
291: $             STSetType(st,STSHELL);
292: $             STShellSetContext(st,ctx);
293: $             STShellSetApply(st,apply);
294: $             STShellSetApplyTranspose(st,applytrans);  (optional)
295: $             STShellSetBackTransform(st,backtr);       (optional)

297: M*/

299: SLEPC_EXTERN PetscErrorCode STCreate_Shell(ST st)
300: {
302:   ST_SHELL       *ctx;

305:   PetscNewLog(st,&ctx);
306:   st->data = (void*)ctx;

308:   st->usesksp = PETSC_FALSE;

310:   st->ops->apply           = STApply_Shell;
311:   st->ops->applytrans      = STApplyTranspose_Shell;
312:   st->ops->backtransform   = STBackTransform_Shell;
313:   st->ops->destroy         = STDestroy_Shell;

315:   PetscObjectComposeFunction((PetscObject)st,"STShellSetApply_C",STShellSetApply_Shell);
316:   PetscObjectComposeFunction((PetscObject)st,"STShellSetApplyTranspose_C",STShellSetApplyTranspose_Shell);
317:   PetscObjectComposeFunction((PetscObject)st,"STShellSetBackTransform_C",STShellSetBackTransform_Shell);
318:   return(0);
319: }