Date: 2017-05-17T08:25:26+00:00

Actual source code: rgbasic.c
slepc-3.7.4 2017-05-17
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: }