Actual source code: rgbasic.c

slepc-3.7.1 2016-05-27
Report Typos and Errors
  1: /*
  2:    Basic routines

  4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  6:    Copyright (c) 2002-2016, Universitat Politecnica de Valencia, Spain

  8:    This file is part of SLEPc.

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

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

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

 24: #include <slepc/private/rgimpl.h>      /*I "slepcrg.h" I*/

 26: PetscFunctionList RGList = 0;
 27: PetscBool         RGRegisterAllCalled = PETSC_FALSE;
 28: PetscClassId      RG_CLASSID = 0;
 29: static PetscBool  RGPackageInitialized = PETSC_FALSE;

 33: /*@C
 34:    RGFinalizePackage - This function destroys everything in the Slepc interface
 35:    to the RG package. It is called from SlepcFinalize().

 37:    Level: developer

 39: .seealso: SlepcFinalize()
 40: @*/
 41: PetscErrorCode RGFinalizePackage(void)
 42: {

 46:   PetscFunctionListDestroy(&RGList);
 47:   RGPackageInitialized = PETSC_FALSE;
 48:   RGRegisterAllCalled  = PETSC_FALSE;
 49:   return(0);
 50: }

 54: /*@C
 55:   RGInitializePackage - This function initializes everything in the RG package.
 56:   It is called from PetscDLLibraryRegister() when using dynamic libraries, and
 57:   on the first call to RGCreate() when using static libraries.

 59:   Level: developer

 61: .seealso: SlepcInitialize()
 62: @*/
 63: PetscErrorCode RGInitializePackage(void)
 64: {
 65:   char             logList[256];
 66:   char             *className;
 67:   PetscBool        opt;
 68:   PetscErrorCode   ierr;

 71:   if (RGPackageInitialized) return(0);
 72:   RGPackageInitialized = PETSC_TRUE;
 73:   /* Register Classes */
 74:   PetscClassIdRegister("Region",&RG_CLASSID);
 75:   /* Register Constructors */
 76:   RGRegisterAll();
 77:   /* Process info exclusions */
 78:   PetscOptionsGetString(NULL,NULL,"-info_exclude",logList,256,&opt);
 79:   if (opt) {
 80:     PetscStrstr(logList,"rg",&className);
 81:     if (className) {
 82:       PetscInfoDeactivateClass(RG_CLASSID);
 83:     }
 84:   }
 85:   /* Process summary exclusions */
 86:   PetscOptionsGetString(NULL,NULL,"-log_exclude",logList,256,&opt);
 87:   if (opt) {
 88:     PetscStrstr(logList,"rg",&className);
 89:     if (className) {
 90:       PetscLogEventDeactivateClass(RG_CLASSID);
 91:     }
 92:   }
 93:   PetscRegisterFinalize(RGFinalizePackage);
 94:   return(0);
 95: }

 99: /*@
100:    RGCreate - Creates an RG context.

102:    Collective on MPI_Comm

104:    Input Parameter:
105: .  comm - MPI communicator

107:    Output Parameter:
108: .  newrg - location to put the RG context

110:    Level: beginner

112: .seealso: RGDestroy(), RG
113: @*/
114: PetscErrorCode RGCreate(MPI_Comm comm,RG *newrg)
115: {
116:   RG             rg;

121:   *newrg = 0;
122:   RGInitializePackage();
123:   SlepcHeaderCreate(rg,RG_CLASSID,"RG","Region","RG",comm,RGDestroy,RGView);
124:   rg->complement = PETSC_FALSE;
125:   rg->sfactor    = 1.0;
126:   rg->osfactor   = 0.0;
127:   rg->data       = NULL;

129:   *newrg = rg;
130:   return(0);
131: }

135: /*@C
136:    RGSetOptionsPrefix - Sets the prefix used for searching for all
137:    RG options in the database.

139:    Logically Collective on RG

141:    Input Parameters:
142: +  rg     - the region context
143: -  prefix - the prefix string to prepend to all RG option requests

145:    Notes:
146:    A hyphen (-) must NOT be given at the beginning of the prefix name.
147:    The first character of all runtime options is AUTOMATICALLY the
148:    hyphen.

150:    Level: advanced

152: .seealso: RGAppendOptionsPrefix()
153: @*/
154: PetscErrorCode RGSetOptionsPrefix(RG rg,const char *prefix)
155: {

160:   PetscObjectSetOptionsPrefix((PetscObject)rg,prefix);
161:   return(0);
162: }

166: /*@C
167:    RGAppendOptionsPrefix - Appends to the prefix used for searching for all
168:    RG options in the database.

170:    Logically Collective on RG

172:    Input Parameters:
173: +  rg     - the region context
174: -  prefix - the prefix string to prepend to all RG option requests

176:    Notes:
177:    A hyphen (-) must NOT be given at the beginning of the prefix name.
178:    The first character of all runtime options is AUTOMATICALLY the hyphen.

180:    Level: advanced

182: .seealso: RGSetOptionsPrefix()
183: @*/
184: PetscErrorCode RGAppendOptionsPrefix(RG rg,const char *prefix)
185: {

190:   PetscObjectAppendOptionsPrefix((PetscObject)rg,prefix);
191:   return(0);
192: }

196: /*@C
197:    RGGetOptionsPrefix - Gets the prefix used for searching for all
198:    RG options in the database.

200:    Not Collective

202:    Input Parameters:
203: .  rg - the region context

205:    Output Parameters:
206: .  prefix - pointer to the prefix string used is returned

208:    Note:
209:    On the Fortran side, the user should pass in a string 'prefix' of
210:    sufficient length to hold the prefix.

212:    Level: advanced

214: .seealso: RGSetOptionsPrefix(), RGAppendOptionsPrefix()
215: @*/
216: PetscErrorCode RGGetOptionsPrefix(RG rg,const char *prefix[])
217: {

223:   PetscObjectGetOptionsPrefix((PetscObject)rg,prefix);
224:   return(0);
225: }

229: /*@C
230:    RGSetType - Selects the type for the RG object.

232:    Logically Collective on RG

234:    Input Parameter:
235: +  rg   - the region context
236: -  type - a known type

238:    Level: intermediate

240: .seealso: RGGetType()
241: @*/
242: PetscErrorCode RGSetType(RG rg,RGType type)
243: {
244:   PetscErrorCode ierr,(*r)(RG);
245:   PetscBool      match;


251:   PetscObjectTypeCompare((PetscObject)rg,type,&match);
252:   if (match) return(0);

254:    PetscFunctionListFind(RGList,type,&r);
255:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)rg),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested RG type %s",type);

257:   if (rg->ops->destroy) { (*rg->ops->destroy)(rg); }
258:   PetscMemzero(rg->ops,sizeof(struct _RGOps));

260:   PetscObjectChangeTypeName((PetscObject)rg,type);
261:   (*r)(rg);
262:   return(0);
263: }

267: /*@C
268:    RGGetType - Gets the RG type name (as a string) from the RG context.

270:    Not Collective

272:    Input Parameter:
273: .  rg - the region context

275:    Output Parameter:
276: .  name - name of the region

278:    Level: intermediate

280: .seealso: RGSetType()
281: @*/
282: PetscErrorCode RGGetType(RG rg,RGType *type)
283: {
287:   *type = ((PetscObject)rg)->type_name;
288:   return(0);
289: }

293: /*@
294:    RGSetFromOptions - Sets RG options from the options database.

296:    Collective on RG

298:    Input Parameters:
299: .  rg - the region context

301:    Notes:
302:    To see all options, run your program with the -help option.

304:    Level: beginner
305: @*/
306: PetscErrorCode RGSetFromOptions(RG rg)
307: {
309:   char           type[256];
310:   PetscBool      flg;
311:   PetscReal      sfactor;

315:   RGRegisterAll();
316:   PetscObjectOptionsBegin((PetscObject)rg);
317:     PetscOptionsFList("-rg_type","Region type","RGSetType",RGList,(char*)(((PetscObject)rg)->type_name?((PetscObject)rg)->type_name:RGINTERVAL),type,256,&flg);
318:     if (flg) {
319:       RGSetType(rg,type);
320:     }
321:     /*
322:       Set the type if it was never set.
323:     */
324:     if (!((PetscObject)rg)->type_name) {
325:       RGSetType(rg,RGINTERVAL);
326:     }

328:     PetscOptionsBool("-rg_complement","Whether region is complemented or not","RGSetComplement",rg->complement,&rg->complement,NULL);
329:     PetscOptionsReal("-rg_scale","Scaling factor","RGSetScale",1.0,&sfactor,&flg);
330:     if (flg) {
331:       RGSetScale(rg,sfactor);
332:     }

334:     if (rg->ops->setfromoptions) {
335:       (*rg->ops->setfromoptions)(PetscOptionsObject,rg);
336:     }
337:     PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)rg);
338:   PetscOptionsEnd();
339:   return(0);
340: }

344: /*@C
345:    RGView - Prints the RG data structure.

347:    Collective on RG

349:    Input Parameters:
350: +  rg - the region context
351: -  viewer - optional visualization context

353:    Note:
354:    The available visualization contexts include
355: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
356: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
357:          output where only the first processor opens
358:          the file.  All other processors send their
359:          data to the first processor to print.

361:    The user can open an alternative visualization context with
362:    PetscViewerASCIIOpen() - output to a specified file.

364:    Level: beginner
365: @*/
366: PetscErrorCode RGView(RG rg,PetscViewer viewer)
367: {
368:   PetscBool      isascii;

373:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)rg));
376:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
377:   if (isascii) {
378:     PetscObjectPrintClassNamePrefixType((PetscObject)rg,viewer);
379:     if (rg->ops->view) {
380:       PetscViewerASCIIPushTab(viewer);
381:       (*rg->ops->view)(rg,viewer);
382:       PetscViewerASCIIPopTab(viewer);
383:     }
384:     if (rg->complement) {
385:       PetscViewerASCIIPrintf(viewer,"  selected region is the complement of the specified one\n");
386:     }
387:     if (rg->sfactor!=1.0) {
388:       PetscViewerASCIIPrintf(viewer,"  scaling factor = %g\n",(double)rg->sfactor);
389:     }
390:   }
391:   return(0);
392: }

396: /*@
397:    RGIsTrivial - Whether it is the trivial region (whole complex plane).

399:    Not Collective

401:    Input Parameter:
402: .  rg - the region context

404:    Output Parameter:
405: .  trivial - true if the region is equal to the whole complex plane, e.g.,
406:              an interval region with all four endpoints unbounded or an
407:              ellipse with infinite radius.

409:    Level: beginner
410: @*/
411: PetscErrorCode RGIsTrivial(RG rg,PetscBool *trivial)
412: {

419:   if (rg->ops->istrivial) {
420:     (*rg->ops->istrivial)(rg,trivial);
421:   } else *trivial = PETSC_FALSE;
422:   return(0);
423: }

427: /*@
428:    RGCheckInside - Determines if a set of given points are inside the region or not.

430:    Not Collective

432:    Input Parameters:
433: +  rg - the region context
434: .  n  - number of points to check
435: .  ar - array of real parts
436: -  ai - array of imaginary parts

438:    Output Parameter:
439: .  inside - array of results (1=inside, 0=on the contour, -1=outside)

441:    Note:
442:    The point a is expressed as a couple of PetscScalar variables ar,ai.
443:    If built with complex scalars, the point is supposed to be stored in ar,
444:    otherwise ar,ai contain the real and imaginary parts, respectively.

446:    If a scaling factor was set, the points are scaled before checking.

448:    Level: intermediate

450: .seealso: RGSetScale(), RGSetComplement()
451: @*/
452: PetscErrorCode RGCheckInside(RG rg,PetscInt n,PetscScalar *ar,PetscScalar *ai,PetscInt *inside)
453: {
455:   PetscReal      px,py;
456:   PetscInt       i;

462: #if !defined(PETSC_USE_COMPLEX)
464: #endif

467:   for (i=0;i<n;i++) {
468: #if defined(PETSC_USE_COMPLEX)
469:     px = PetscRealPart(ar[i]);
470:     py = PetscImaginaryPart(ar[i]);
471: #else
472:     px = ar[i];
473:     py = ai[i];
474: #endif
475:     if (rg->sfactor != 1.0) {
476:       px /= rg->sfactor;
477:       py /= rg->sfactor;
478:     }
479:     (*rg->ops->checkinside)(rg,px,py,inside+i);
480:     if (rg->complement) inside[i] = -inside[i];
481:   }
482:   return(0);
483: }

487: /*@
488:    RGComputeContour - Computes the coordinates of several points lying in the
489:    contour of the region.

491:    Not Collective

493:    Input Parameters:
494: +  rg - the region context
495: -  n  - number of points to compute

497:    Output Parameter:
498: +  cr - location to store real parts
499: -  ci - location to store imaginary parts

501:    Level: intermediate
502: @*/
503: PetscErrorCode RGComputeContour(RG rg,PetscInt n,PetscScalar *cr,PetscScalar *ci)
504: {
505:   PetscInt       i;

512: #if !defined(PETSC_USE_COMPLEX)
514: #endif
515:   (*rg->ops->computecontour)(rg,n,cr,ci);
516:   for (i=0;i<n;i++) {
517:     cr[i] *= rg->sfactor;
518:     ci[i] *= rg->sfactor;
519:   }
520:   return(0);
521: }

525: /*@
526:    RGSetComplement - Sets a flag to indicate that the region is the complement
527:    of the specified one.

529:    Logically Collective on RG

531:    Input Parameters:
532: +  rg  - the region context
533: -  flg - the boolean flag

535:    Options Database Key:
536: .  -rg_complement <bool> - Activate/deactivate the complementation of the region

538:    Level: intermediate

540: .seealso: RGGetComplement()
541: @*/
542: PetscErrorCode RGSetComplement(RG rg,PetscBool flg)
543: {
547:   rg->complement = flg;
548:   return(0);
549: }

553: /*@
554:    RGGetComplement - Gets a flag that that indicates whether the region
555:    is complemented or not.

557:    Not Collective

559:    Input Parameter:
560: .  rg - the region context

562:    Output Parameter:
563: .  flg - the flag

565:    Level: intermediate

567: .seealso: RGSetComplement()
568: @*/
569: PetscErrorCode RGGetComplement(RG rg,PetscBool *flg)
570: {
574:   *flg = rg->complement;
575:   return(0);
576: }

580: /*@
581:    RGSetScale - Sets the scaling factor to be used when checking that a
582:    point is inside the region and when computing the contour.

584:    Logically Collective on RG

586:    Input Parameters:
587: +  rg      - the region context
588: -  sfactor - the scaling factor

590:    Options Database Key:
591: .  -rg_scale <real> - Sets the scaling factor

593:    Level: advanced

595: .seealso: RGGetScale(), RGCheckInside()
596: @*/
597: PetscErrorCode RGSetScale(RG rg,PetscReal sfactor)
598: {
602:   if (sfactor == PETSC_DEFAULT || sfactor == PETSC_DECIDE) rg->sfactor = 1.0;
603:   else {
604:     if (sfactor<=0.0) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of scaling factor. Must be > 0");
605:     rg->sfactor = sfactor;
606:   }
607:   return(0);
608: }

612: /*@
613:    RGGetScale - Gets the scaling factor.

615:    Not Collective

617:    Input Parameter:
618: .  rg - the region context

620:    Output Parameter:
621: .  flg - the flag

623:    Level: advanced

625: .seealso: RGSetScale()
626: @*/
627: PetscErrorCode RGGetScale(RG rg,PetscReal *sfactor)
628: {
632:   *sfactor = rg->sfactor;
633:   return(0);
634: }

638: /*@
639:    RGPushScale - Sets an additional scaling factor, that will multiply the
640:    user-defined scaling factor.

642:    Logically Collective on RG

644:    Input Parameters:
645: +  rg      - the region context
646: -  sfactor - the scaling factor

648:    Notes:
649:    The current implementation does not allow pushing several scaling factors.

651:    This is intended for internal use, for instance in polynomial eigensolvers
652:    that use parameter scaling.

654:    Level: developer

656: .seealso: RGPopScale(), RGSetScale()
657: @*/
658: PetscErrorCode RGPushScale(RG rg,PetscReal sfactor)
659: {
663:   if (sfactor<=0.0) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of scaling factor. Must be > 0");
664:   if (rg->osfactor) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_SUP,"Current implementation does not allow pushing several scaling factors");
665:   rg->osfactor = rg->sfactor;
666:   rg->sfactor *= sfactor;
667:   return(0);
668: }

672: /*@
673:    RGPopScale - Pops the scaling factor set with RGPushScale().

675:    Not Collective

677:    Input Parameter:
678: .  rg - the region context

680:    Level: developer

682: .seealso: RGPushScale()
683: @*/
684: PetscErrorCode RGPopScale(RG rg)
685: {
688:   if (!rg->osfactor) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ORDER,"Must call RGPushScale first");
689:   rg->sfactor  = rg->osfactor;
690:   rg->osfactor = 0.0;
691:   return(0);
692: }

696: /*@
697:    RGDestroy - Destroys RG context that was created with RGCreate().

699:    Collective on RG

701:    Input Parameter:
702: .  rg - the region context

704:    Level: beginner

706: .seealso: RGCreate()
707: @*/
708: PetscErrorCode RGDestroy(RG *rg)
709: {

713:   if (!*rg) return(0);
715:   if (--((PetscObject)(*rg))->refct > 0) { *rg = 0; return(0); }
716:   if ((*rg)->ops->destroy) { (*(*rg)->ops->destroy)(*rg); }
717:   PetscHeaderDestroy(rg);
718:   return(0);
719: }

723: /*@C
724:    RGRegister - Adds a region to the RG package.

726:    Not collective

728:    Input Parameters:
729: +  name - name of a new user-defined RG
730: -  function - routine to create context

732:    Notes:
733:    RGRegister() may be called multiple times to add several user-defined regions.

735:    Level: advanced

737: .seealso: RGRegisterAll()
738: @*/
739: PetscErrorCode RGRegister(const char *name,PetscErrorCode (*function)(RG))
740: {

744:   PetscFunctionListAdd(&RGList,name,function);
745:   return(0);
746: }