Actual source code: shell.c
slepc-3.21.0 2024-03-30
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: }