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(), RG113: @*/
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 RG141: 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 RG172: 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 RG234: 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 RG298: 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 RG349: 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 RG531: 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 RG586: 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 RG644: 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 RG701: 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 - See Adds a mathematical function to the RG package.
726: Not collective
728: Input Parameters:
729: + name - name of a new user-defined RG730: - function - routine to create context
732: Notes:
733: RGRegister() may be called multiple times to add several user-defined inner products.
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: }