Date: 2021-02-01T14:41:52+00:00

Actual source code: rgbasic.c
slepc-3.14.2 2021-02-01
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2020, 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: /*@
    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: }