Actual source code: shell.c

  1: /*
  2:    This provides a simple shell interface for programmers to 
  3:    create their own spectral transformations without writing much 
  4:    interface code.

  6:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  7:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  8:    Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain

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

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

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

 26:  #include private/stimpl.h
 27:  #include slepceps.h

 30: typedef struct {
 31:   void           *ctx;                       /* user provided context */
 32:   PetscErrorCode (*apply)(void *,Vec,Vec);
 33:   PetscErrorCode (*applytrans)(void *,Vec,Vec);
 34:   PetscErrorCode (*backtr)(void *,PetscScalar*,PetscScalar*);
 35:   char           *name;
 36: } ST_Shell;

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

 44:     Not Collective

 46:     Input Parameter:
 47: .   st - spectral transformation context

 49:     Output Parameter:
 50: .   ctx - the user provided context

 52:     Level: advanced

 54:     Notes:
 55:     This routine is intended for use within various shell routines
 56:     
 57: .seealso: STShellSetContext()
 58: @*/
 59: PetscErrorCode STShellGetContext(ST st,void **ctx)
 60: {
 62:   PetscTruth     flg;

 67:   PetscTypeCompare((PetscObject)st,STSHELL,&flg);
 68:   if (!flg) *ctx = 0;
 69:   else      *ctx = ((ST_Shell*)(st->data))->ctx;
 70:   return(0);
 71: }

 75: /*@C
 76:     STShellSetContext - sets the context for a shell ST

 78:    Collective on ST

 80:     Input Parameters:
 81: +   st - the shell ST
 82: -   ctx - the context

 84:    Level: advanced

 86:    Fortran Notes: The context can only be an integer or a PetscObject;
 87:       unfortunately it cannot be a Fortran array or derived type.

 89: .seealso: STShellGetContext()
 90: @*/
 91: PetscErrorCode STShellSetContext(ST st,void *ctx)
 92: {
 93:   ST_Shell      *shell = (ST_Shell*)st->data;
 95:   PetscTruth     flg;

 99:   PetscTypeCompare((PetscObject)st,STSHELL,&flg);
100:   if (flg) {
101:     shell->ctx = ctx;
102:   }
103:   return(0);
104: }

108: PetscErrorCode STApply_Shell(ST st,Vec x,Vec y)
109: {
111:   ST_Shell       *shell = (ST_Shell*)st->data;

114:   if (!shell->apply) SETERRQ(PETSC_ERR_USER,"No apply() routine provided to Shell ST");
115:   PetscStackPush("STSHELL user function");
116:   CHKMEMQ;
117:   (*shell->apply)(shell->ctx,x,y);
118:   CHKMEMQ;
119:   PetscStackPop;
120:   return(0);
121: }

125: PetscErrorCode STApplyTranspose_Shell(ST st,Vec x,Vec y)
126: {
128:   ST_Shell       *shell = (ST_Shell*)st->data;

131:   if (!shell->applytrans) SETERRQ(PETSC_ERR_USER,"No applytranspose() routine provided to Shell ST");
132:   (*shell->applytrans)(shell->ctx,x,y);
133:   return(0);
134: }

138: PetscErrorCode STBackTransform_Shell(ST st,PetscScalar *eigr,PetscScalar *eigi)
139: {
141:   ST_Shell       *shell = (ST_Shell*)st->data;

144:   if (shell->backtr) {
145:     (*shell->backtr)(shell->ctx,eigr,eigi);
146:   }
147:   return(0);
148: }

152: PetscErrorCode STDestroy_Shell(ST st)
153: {
155:   ST_Shell       *shell = (ST_Shell*)st->data;

158:   PetscFree(shell->name);
159:   PetscFree(shell);
160:   return(0);
161: }

165: PetscErrorCode STView_Shell(ST st,PetscViewer viewer)
166: {
168:   ST_Shell       *ctx = (ST_Shell*)st->data;
169:   PetscTruth     isascii;

172:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
173:   if (isascii) {
174:     if (ctx->name) {PetscViewerASCIIPrintf(viewer,"  ST Shell: %s\n",ctx->name);}
175:     else           {PetscViewerASCIIPrintf(viewer,"  ST Shell: no name\n");}
176:   } else {
177:     SETERRQ1(1,"Viewer type %s not supported for STShell",((PetscObject)viewer)->type_name);
178:   }
179:   return(0);
180: }

185: PetscErrorCode STShellSetApply_Shell(ST st,PetscErrorCode (*apply)(void*,Vec,Vec))
186: {
187:   ST_Shell *shell = (ST_Shell*)st->data;

190:   shell->apply = apply;
191:   return(0);
192: }

198: PetscErrorCode STShellSetApplyTranspose_Shell(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec))
199: {
200:   ST_Shell *shell = (ST_Shell*)st->data;

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

211: PetscErrorCode STShellSetBackTransform_Shell(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*))
212: {
213:   ST_Shell *shell = (ST_Shell *) st->data;

216:   shell->backtr = backtr;
217:   return(0);
218: }

224: PetscErrorCode STShellSetName_Shell(ST st,const char name[])
225: {
226:   ST_Shell *shell = (ST_Shell*)st->data;

230:   PetscStrfree(shell->name);
231:   PetscStrallocpy(name,&shell->name);
232:   return(0);
233: }

239: PetscErrorCode STShellGetName_Shell(ST st,char *name[])
240: {
241:   ST_Shell *shell = (ST_Shell*)st->data;

244:   *name  = shell->name;
245:   return(0);
246: }

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

255:    Collective on ST

257:    Input Parameters:
258: +  st    - the spectral transformation context
259: -  apply - the application-provided transformation routine

261:    Calling sequence of apply:
262: .vb
263:    PetscErrorCode apply (void *ptr,Vec xin,Vec xout)
264: .ve

266: +  ptr  - the application context
267: .  xin  - input vector
268: -  xout - output vector

270:    Level: developer

272: .seealso: STShellSetBackTransform(), STShellSetApplyTranspose()
273: @*/
274: PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(void*,Vec,Vec))
275: {
276:   PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec));

280:   PetscObjectQueryFunction((PetscObject)st,"STShellSetApply_C",(void (**)(void))&f);
281:   if (f) {
282:     (*f)(st,apply);
283:   }
284:   return(0);
285: }

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

293:    Collective on ST

295:    Input Parameters:
296: +  st    - the spectral transformation context
297: -  applytrans - the application-provided transformation routine

299:    Calling sequence of apply:
300: .vb
301:    PetscErrorCode applytrans (void *ptr,Vec xin,Vec xout)
302: .ve

304: +  ptr  - the application context
305: .  xin  - input vector
306: -  xout - output vector

308:    Level: developer

310: .seealso: STShellSetApply(), STShellSetBackTransform()
311: @*/
312: PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec))
313: {
314:   PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec));

318:   PetscObjectQueryFunction((PetscObject)st,"STShellSetApplyTranspose_C",(void (**)(void))&f);
319:   if (f) {
320:     (*f)(st,applytrans);
321:   }
322:   return(0);
323: }

327: /*@C
328:    STShellSetBackTransform - Sets the routine to be called after the 
329:    eigensolution process has finished in order to transform back the
330:    computed eigenvalues.

332:    Collective on ST

334:    Input Parameters:
335: +  st     - the spectral transformation context
336: -  backtr - the application-provided backtransform routine

338:    Calling sequence of backtr:
339: .vb
340:    PetscErrorCode backtr (void *ptr,PetscScalar *eigr,PetscScalar *eigi)
341: .ve

343: +  ptr  - the application context
344: .  eigr - pointer ot the real part of the eigenvalue to transform back
345: -  eigi - pointer ot the imaginary part 

347:    Level: developer

349: .seealso: STShellSetApply(), STShellSetApplyTranspose()
350: @*/
351: PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*))
352: {
353:   PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,PetscScalar*,PetscScalar*));

357:   PetscObjectQueryFunction((PetscObject)st,"STShellSetBackTransform_C",(void (**)(void))&f);
358:   if (f) {
359:     (*f)(st,(PetscErrorCode (*)(void*,PetscScalar*,PetscScalar*))backtr);
360:   }
361:   return(0);
362: }

366: /*@C
367:    STShellSetName - Sets an optional name to associate with a shell
368:    spectral transformation.

370:    Not Collective

372:    Input Parameters:
373: +  st   - the spectral transformation context
374: -  name - character string describing the shell spectral transformation

376:    Level: developer

378: .seealso: STShellGetName()
379: @*/
380: PetscErrorCode STShellSetName(ST st,const char name[])
381: {
382:   PetscErrorCode ierr, (*f)(ST,const char []);

386:   PetscObjectQueryFunction((PetscObject)st,"STShellSetName_C",(void (**)(void))&f);
387:   if (f) {
388:     (*f)(st,name);
389:   }
390:   return(0);
391: }

395: /*@C
396:    STShellGetName - Gets an optional name that the user has set for a shell
397:    spectral transformation.

399:    Not Collective

401:    Input Parameter:
402: .  st - the spectral transformation context

404:    Output Parameter:
405: .  name - character string describing the shell spectral transformation 
406:           (you should not free this)

408:    Level: developer

410: .seealso: STShellSetName()
411: @*/
412: PetscErrorCode STShellGetName(ST st,char *name[])
413: {
414:   PetscErrorCode ierr, (*f)(ST,char *[]);

418:   PetscObjectQueryFunction((PetscObject)st,"STShellGetName_C",(void (**)(void))&f);
419:   if (f) {
420:     (*f)(st,name);
421:   } else {
422:     SETERRQ(PETSC_ERR_ARG_WRONG,"Not shell spectral transformation, cannot get name");
423:   }
424:   return(0);
425: }

427: /*MC
428:    STSHELL - Creates a new spectral transformation class.
429:           This is intended to provide a simple class to use with EPS.
430:           You should not use this if you plan to make a complete class.

432:   Level: advanced

434:   Usage:
435: $             PetscErrorCode (*apply)(void*,Vec,Vec);
436: $             PetscErrorCode (*applytrans)(void*,Vec,Vec);
437: $             PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*);
438: $             STCreate(comm,&st);
439: $             STSetType(st,STSHELL);
440: $             STShellSetApply(st,apply);
441: $             STShellSetApplyTranspose(st,applytrans);
442: $             STShellSetBackTransform(st,backtr);    (optional)

444: M*/

449: PetscErrorCode STCreate_Shell(ST st)
450: {
452:   ST_Shell       *shell;

455:   st->ops->destroy = STDestroy_Shell;
456:   PetscNew(ST_Shell,&shell);
457:   PetscLogObjectMemory(st,sizeof(ST_Shell));

459:   st->data           = (void *) shell;
460:   ((PetscObject)st)->name           = 0;

462:   st->ops->apply     = STApply_Shell;
463:   st->ops->applytrans= STApplyTranspose_Shell;
464:   st->ops->backtr    = STBackTransform_Shell;
465:   st->ops->view      = STView_Shell;

467:   shell->apply       = 0;
468:   shell->applytrans  = 0;
469:   shell->backtr      = 0;
470:   shell->name        = 0;
471:   shell->ctx         = 0;

473:   PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApply_C","STShellSetApply_Shell",
474:                     STShellSetApply_Shell);
475:   PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApplyTranspose_C","STShellSetApplyTranspose_Shell",
476:                     STShellSetApplyTranspose_Shell);
477:   PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetBackTransform_C","STShellSetBackTransform_Shell",
478:                     STShellSetBackTransform_Shell);
479:   PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetName_C","STShellSetName_Shell",
480:                     STShellSetName_Shell);
481:   PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellGetName_C","STShellGetName_Shell",
482:                     STShellGetName_Shell);

484:   return(0);
485: }