Actual source code: rgbasic.c

slepc-3.15.1 2021-05-28
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:    Basic RG routines
 12: */

 14: #include <slepc/private/rgimpl.h>

 16: PetscFunctionList RGList = 0;
 17: PetscBool         RGRegisterAllCalled = PETSC_FALSE;
 18: PetscClassId      RG_CLASSID = 0;
 19: static PetscBool  RGPackageInitialized = PETSC_FALSE;

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

 25:    Level: developer

 27: .seealso: SlepcFinalize()
 28: @*/
 29: PetscErrorCode RGFinalizePackage(void)
 30: {

 34:   PetscFunctionListDestroy(&RGList);
 35:   RGPackageInitialized = PETSC_FALSE;
 36:   RGRegisterAllCalled  = PETSC_FALSE;
 37:   return(0);
 38: }

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

 45:   Level: developer

 47: .seealso: SlepcInitialize()
 48: @*/
 49: PetscErrorCode RGInitializePackage(void)
 50: {
 51:   char           logList[256];
 52:   PetscBool      opt,pkg;
 53:   PetscClassId   classids[1];

 57:   if (RGPackageInitialized) return(0);
 58:   RGPackageInitialized = PETSC_TRUE;
 59:   /* Register Classes */
 60:   PetscClassIdRegister("Region",&RG_CLASSID);
 61:   /* Register Constructors */
 62:   RGRegisterAll();
 63:   /* Process Info */
 64:   classids[0] = RG_CLASSID;
 65:   PetscInfoProcessClass("rg",1,&classids[0]);
 66:   /* Process summary exclusions */
 67:   PetscOptionsGetString(NULL,NULL,"-log_exclude",logList,sizeof(logList),&opt);
 68:   if (opt) {
 69:     PetscStrInList("rg",logList,',',&pkg);
 70:     if (pkg) { PetscLogEventDeactivateClass(RG_CLASSID); }
 71:   }
 72:   /* Register package finalizer */
 73:   PetscRegisterFinalize(RGFinalizePackage);
 74:   return(0);
 75: }

 77: /*@
 78:    RGCreate - Creates an RG context.

 80:    Collective

 82:    Input Parameter:
 83: .  comm - MPI communicator

 85:    Output Parameter:
 86: .  newrg - location to put the RG context

 88:    Level: beginner

 90: .seealso: RGDestroy(), RG
 91: @*/
 92: PetscErrorCode RGCreate(MPI_Comm comm,RG *newrg)
 93: {
 94:   RG             rg;

 99:   *newrg = 0;
100:   RGInitializePackage();
101:   SlepcHeaderCreate(rg,RG_CLASSID,"RG","Region","RG",comm,RGDestroy,RGView);
102:   rg->complement = PETSC_FALSE;
103:   rg->sfactor    = 1.0;
104:   rg->osfactor   = 0.0;
105:   rg->data       = NULL;

107:   *newrg = rg;
108:   return(0);
109: }

111: /*@C
112:    RGSetOptionsPrefix - Sets the prefix used for searching for all
113:    RG options in the database.

115:    Logically Collective on rg

117:    Input Parameters:
118: +  rg     - the region context
119: -  prefix - the prefix string to prepend to all RG option requests

121:    Notes:
122:    A hyphen (-) must NOT be given at the beginning of the prefix name.
123:    The first character of all runtime options is AUTOMATICALLY the
124:    hyphen.

126:    Level: advanced

128: .seealso: RGAppendOptionsPrefix()
129: @*/
130: PetscErrorCode RGSetOptionsPrefix(RG rg,const char *prefix)
131: {

136:   PetscObjectSetOptionsPrefix((PetscObject)rg,prefix);
137:   return(0);
138: }

140: /*@C
141:    RGAppendOptionsPrefix - Appends to the prefix used for searching for all
142:    RG options in the database.

144:    Logically Collective on rg

146:    Input Parameters:
147: +  rg     - the region context
148: -  prefix - the prefix string to prepend to all RG option requests

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

154:    Level: advanced

156: .seealso: RGSetOptionsPrefix()
157: @*/
158: PetscErrorCode RGAppendOptionsPrefix(RG rg,const char *prefix)
159: {

164:   PetscObjectAppendOptionsPrefix((PetscObject)rg,prefix);
165:   return(0);
166: }

168: /*@C
169:    RGGetOptionsPrefix - Gets the prefix used for searching for all
170:    RG options in the database.

172:    Not Collective

174:    Input Parameters:
175: .  rg - the region context

177:    Output Parameters:
178: .  prefix - pointer to the prefix string used is returned

180:    Note:
181:    On the Fortran side, the user should pass in a string 'prefix' of
182:    sufficient length to hold the prefix.

184:    Level: advanced

186: .seealso: RGSetOptionsPrefix(), RGAppendOptionsPrefix()
187: @*/
188: PetscErrorCode RGGetOptionsPrefix(RG rg,const char *prefix[])
189: {

195:   PetscObjectGetOptionsPrefix((PetscObject)rg,prefix);
196:   return(0);
197: }

199: /*@C
200:    RGSetType - Selects the type for the RG object.

202:    Logically Collective on rg

204:    Input Parameter:
205: +  rg   - the region context
206: -  type - a known type

208:    Level: intermediate

210: .seealso: RGGetType()
211: @*/
212: PetscErrorCode RGSetType(RG rg,RGType type)
213: {
214:   PetscErrorCode ierr,(*r)(RG);
215:   PetscBool      match;


221:   PetscObjectTypeCompare((PetscObject)rg,type,&match);
222:   if (match) return(0);

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

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

230:   PetscObjectChangeTypeName((PetscObject)rg,type);
231:   (*r)(rg);
232:   return(0);
233: }

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

238:    Not Collective

240:    Input Parameter:
241: .  rg - the region context

243:    Output Parameter:
244: .  name - name of the region

246:    Level: intermediate

248: .seealso: RGSetType()
249: @*/
250: PetscErrorCode RGGetType(RG rg,RGType *type)
251: {
255:   *type = ((PetscObject)rg)->type_name;
256:   return(0);
257: }

259: /*@
260:    RGSetFromOptions - Sets RG options from the options database.

262:    Collective on rg

264:    Input Parameters:
265: .  rg - the region context

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

270:    Level: beginner
271: @*/
272: PetscErrorCode RGSetFromOptions(RG rg)
273: {
275:   char           type[256];
276:   PetscBool      flg;
277:   PetscReal      sfactor;

281:   RGRegisterAll();
282:   PetscObjectOptionsBegin((PetscObject)rg);
283:     PetscOptionsFList("-rg_type","Region type","RGSetType",RGList,(char*)(((PetscObject)rg)->type_name?((PetscObject)rg)->type_name:RGINTERVAL),type,sizeof(type),&flg);
284:     if (flg) {
285:       RGSetType(rg,type);
286:     } else if (!((PetscObject)rg)->type_name) {
287:       RGSetType(rg,RGINTERVAL);
288:     }

290:     PetscOptionsBool("-rg_complement","Whether region is complemented or not","RGSetComplement",rg->complement,&rg->complement,NULL);

292:     PetscOptionsReal("-rg_scale","Scaling factor","RGSetScale",1.0,&sfactor,&flg);
293:     if (flg) { RGSetScale(rg,sfactor); }

295:     if (rg->ops->setfromoptions) {
296:       (*rg->ops->setfromoptions)(PetscOptionsObject,rg);
297:     }
298:     PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)rg);
299:   PetscOptionsEnd();
300:   return(0);
301: }

303: /*@C
304:    RGView - Prints the RG data structure.

306:    Collective on rg

308:    Input Parameters:
309: +  rg - the region context
310: -  viewer - optional visualization context

312:    Note:
313:    The available visualization contexts include
314: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
315: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
316:          output where only the first processor opens
317:          the file.  All other processors send their
318:          data to the first processor to print.

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

323:    Level: beginner
324: @*/
325: PetscErrorCode RGView(RG rg,PetscViewer viewer)
326: {
327:   PetscBool      isdraw,isascii;

332:   if (!viewer) {
333:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)rg),&viewer);
334:   }
337:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);
338:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
339:   if (isascii) {
340:     PetscObjectPrintClassNamePrefixType((PetscObject)rg,viewer);
341:     if (rg->ops->view) {
342:       PetscViewerASCIIPushTab(viewer);
343:       (*rg->ops->view)(rg,viewer);
344:       PetscViewerASCIIPopTab(viewer);
345:     }
346:     if (rg->complement) {
347:       PetscViewerASCIIPrintf(viewer,"  selected region is the complement of the specified one\n");
348:     }
349:     if (rg->sfactor!=1.0) {
350:       PetscViewerASCIIPrintf(viewer,"  scaling factor = %g\n",(double)rg->sfactor);
351:     }
352:   } else if (isdraw) {
353:     if (rg->ops->view) { (*rg->ops->view)(rg,viewer); }
354:   }
355:   return(0);
356: }

358: /*@C
359:    RGViewFromOptions - View from options

361:    Collective on RG

363:    Input Parameters:
364: +  rg   - the region context
365: .  obj  - optional object
366: -  name - command line option

368:    Level: intermediate

370: .seealso: RGView(), RGCreate()
371: @*/
372: PetscErrorCode RGViewFromOptions(RG rg,PetscObject obj,const char name[])
373: {

378:   PetscObjectViewFromOptions((PetscObject)rg,obj,name);
379:   return(0);
380: }

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

385:    Not Collective

387:    Input Parameter:
388: .  rg - the region context

390:    Output Parameter:
391: .  trivial - true if the region is equal to the whole complex plane, e.g.,
392:              an interval region with all four endpoints unbounded or an
393:              ellipse with infinite radius.

395:    Level: beginner
396: @*/
397: PetscErrorCode RGIsTrivial(RG rg,PetscBool *trivial)
398: {

405:   if (rg->ops->istrivial) {
406:     (*rg->ops->istrivial)(rg,trivial);
407:   } else *trivial = PETSC_FALSE;
408:   return(0);
409: }

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

414:    Not Collective

416:    Input Parameters:
417: +  rg - the region context
418: .  n  - number of points to check
419: .  ar - array of real parts
420: -  ai - array of imaginary parts

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

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

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

432:    Level: intermediate

434: .seealso: RGSetScale(), RGSetComplement()
435: @*/
436: PetscErrorCode RGCheckInside(RG rg,PetscInt n,PetscScalar *ar,PetscScalar *ai,PetscInt *inside)
437: {
439:   PetscReal      px,py;
440:   PetscInt       i;

446: #if !defined(PETSC_USE_COMPLEX)
448: #endif

451:   for (i=0;i<n;i++) {
452: #if defined(PETSC_USE_COMPLEX)
453:     px = PetscRealPart(ar[i]);
454:     py = PetscImaginaryPart(ar[i]);
455: #else
456:     px = ar[i];
457:     py = ai[i];
458: #endif
459:     if (rg->sfactor != 1.0) {
460:       px /= rg->sfactor;
461:       py /= rg->sfactor;
462:     }
463:     (*rg->ops->checkinside)(rg,px,py,inside+i);
464:     if (rg->complement) inside[i] = -inside[i];
465:   }
466:   return(0);
467: }

469: /*@
470:    RGComputeContour - Computes the coordinates of several points lying on the
471:    contour of the region.

473:    Not Collective

475:    Input Parameters:
476: +  rg - the region context
477: -  n  - number of points to compute

479:    Output Parameters:
480: +  cr - location to store real parts
481: -  ci - location to store imaginary parts

483:    Level: intermediate
484: @*/
485: PetscErrorCode RGComputeContour(RG rg,PetscInt n,PetscScalar cr[],PetscScalar ci[])
486: {
487:   PetscInt       i;

494: #if !defined(PETSC_USE_COMPLEX)
496: #endif
497:   if (rg->complement) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_SUP,"Cannot compute contour of region with complement flag set");
498:   (*rg->ops->computecontour)(rg,n,cr,ci);
499:   for (i=0;i<n;i++) {
500:     cr[i] *= rg->sfactor;
501:     ci[i] *= rg->sfactor;
502:   }
503:   return(0);
504: }

506: /*@
507:    RGComputeBoundingBox - Determines the endpoints of a rectangle in the complex plane that
508:    contains the region.

510:    Not Collective

512:    Input Parameters:
513: .  rg - the region context

515:    Output Parameters:
516: +  a,b - endpoints of the bounding box in the real axis
517: -  c,d - endpoints of the bounding box in the imaginary axis

519:    Notes:
520:    The bounding box is defined as [a,b]x[c,d]. In regions that are not bounded (e.g. an
521:    open interval) or with the complement flag set, it makes no sense to compute a bounding
522:    box, so the return values are infinite.

524:    Level: intermediate

526: .seealso: RGSetComplement()
527: @*/
528: PetscErrorCode RGComputeBoundingBox(RG rg,PetscReal *a,PetscReal *b,PetscReal *c,PetscReal *d)
529: {


536:   if (rg->complement) {  /* cannot compute bounding box */
537:     if (a) *a = -PETSC_MAX_REAL;
538:     if (b) *b =  PETSC_MAX_REAL;
539:     if (c) *c = -PETSC_MAX_REAL;
540:     if (d) *d =  PETSC_MAX_REAL;
541:   } else {
542:     (*rg->ops->computebbox)(rg,a,b,c,d);
543:     if (a && *a!=-PETSC_MAX_REAL) *a *= rg->sfactor;
544:     if (b && *b!= PETSC_MAX_REAL) *b *= rg->sfactor;
545:     if (c && *c!=-PETSC_MAX_REAL) *c *= rg->sfactor;
546:     if (d && *d!= PETSC_MAX_REAL) *d *= rg->sfactor;
547:   }
548:   return(0);
549: }

551: /*@
552:    RGSetComplement - Sets a flag to indicate that the region is the complement
553:    of the specified one.

555:    Logically Collective on rg

557:    Input Parameters:
558: +  rg  - the region context
559: -  flg - the boolean flag

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

564:    Level: intermediate

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

577: /*@
578:    RGGetComplement - Gets a flag that that indicates whether the region
579:    is complemented or not.

581:    Not Collective

583:    Input Parameter:
584: .  rg - the region context

586:    Output Parameter:
587: .  flg - the flag

589:    Level: intermediate

591: .seealso: RGSetComplement()
592: @*/
593: PetscErrorCode RGGetComplement(RG rg,PetscBool *flg)
594: {
598:   *flg = rg->complement;
599:   return(0);
600: }

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

606:    Logically Collective on rg

608:    Input Parameters:
609: +  rg      - the region context
610: -  sfactor - the scaling factor

612:    Options Database Key:
613: .  -rg_scale <real> - Sets the scaling factor

615:    Level: advanced

617: .seealso: RGGetScale(), RGCheckInside()
618: @*/
619: PetscErrorCode RGSetScale(RG rg,PetscReal sfactor)
620: {
624:   if (sfactor == PETSC_DEFAULT || sfactor == PETSC_DECIDE) rg->sfactor = 1.0;
625:   else {
626:     if (sfactor<=0.0) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of scaling factor. Must be > 0");
627:     rg->sfactor = sfactor;
628:   }
629:   return(0);
630: }

632: /*@
633:    RGGetScale - Gets the scaling factor.

635:    Not Collective

637:    Input Parameter:
638: .  rg - the region context

640:    Output Parameter:
641: .  flg - the flag

643:    Level: advanced

645: .seealso: RGSetScale()
646: @*/
647: PetscErrorCode RGGetScale(RG rg,PetscReal *sfactor)
648: {
652:   *sfactor = rg->sfactor;
653:   return(0);
654: }

656: /*@
657:    RGPushScale - Sets an additional scaling factor, that will multiply the
658:    user-defined scaling factor.

660:    Logically Collective on rg

662:    Input Parameters:
663: +  rg      - the region context
664: -  sfactor - the scaling factor

666:    Notes:
667:    The current implementation does not allow pushing several scaling factors.

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

672:    Level: developer

674: .seealso: RGPopScale(), RGSetScale()
675: @*/
676: PetscErrorCode RGPushScale(RG rg,PetscReal sfactor)
677: {
681:   if (sfactor<=0.0) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of scaling factor. Must be > 0");
682:   if (rg->osfactor) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_SUP,"Current implementation does not allow pushing several scaling factors");
683:   rg->osfactor = rg->sfactor;
684:   rg->sfactor *= sfactor;
685:   return(0);
686: }

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

691:    Not Collective

693:    Input Parameter:
694: .  rg - the region context

696:    Level: developer

698: .seealso: RGPushScale()
699: @*/
700: PetscErrorCode RGPopScale(RG rg)
701: {
704:   if (!rg->osfactor) SETERRQ(PetscObjectComm((PetscObject)rg),PETSC_ERR_ORDER,"Must call RGPushScale first");
705:   rg->sfactor  = rg->osfactor;
706:   rg->osfactor = 0.0;
707:   return(0);
708: }

710: /*@C
711:    RGDestroy - Destroys RG context that was created with RGCreate().

713:    Collective on rg

715:    Input Parameter:
716: .  rg - the region context

718:    Level: beginner

720: .seealso: RGCreate()
721: @*/
722: PetscErrorCode RGDestroy(RG *rg)
723: {

727:   if (!*rg) return(0);
729:   if (--((PetscObject)(*rg))->refct > 0) { *rg = 0; return(0); }
730:   if ((*rg)->ops->destroy) { (*(*rg)->ops->destroy)(*rg); }
731:   PetscHeaderDestroy(rg);
732:   return(0);
733: }

735: /*@C
736:    RGRegister - Adds a region to the RG package.

738:    Not collective

740:    Input Parameters:
741: +  name - name of a new user-defined RG
742: -  function - routine to create context

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

747:    Level: advanced

749: .seealso: RGRegisterAll()
750: @*/
751: PetscErrorCode RGRegister(const char *name,PetscErrorCode (*function)(RG))
752: {

756:   RGInitializePackage();
757:   PetscFunctionListAdd(&RGList,name,function);
758:   return(0);
759: }