Actual source code: ipbasic.c
1: /*
2: Basic routines
4: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
5: SLEPc - Scalable Library for Eigenvalue Problem Computations
6: Copyright (c) 2002-2012, Universitat Politecnica de Valencia, Spain
8: This file is part of SLEPc.
9:
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/ipimpl.h> /*I "slepcip.h" I*/
26: PetscFList IPList = 0;
27: PetscBool IPRegisterAllCalled = PETSC_FALSE;
28: PetscClassId IP_CLASSID = 0;
29: PetscLogEvent IP_InnerProduct = 0,IP_Orthogonalize = 0,IP_ApplyMatrix = 0;
30: static PetscBool IPPackageInitialized = PETSC_FALSE;
34: /*@C
35: IPFinalizePackage - This function destroys everything in the Slepc interface
36: to the IP package. It is called from SlepcFinalize().
38: Level: developer
40: .seealso: SlepcFinalize()
41: @*/
42: PetscErrorCode IPFinalizePackage(void)
43: {
45: IPPackageInitialized = PETSC_FALSE;
46: IPList = 0;
47: IPRegisterAllCalled = PETSC_FALSE;
48: return(0);
49: }
53: /*@C
54: IPInitializePackage - This function initializes everything in the IP package. It is called
55: from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to IPCreate()
56: when using static libraries.
58: Input Parameter:
59: path - The dynamic library path, or PETSC_NULL
61: Level: developer
63: .seealso: SlepcInitialize()
64: @*/
65: PetscErrorCode IPInitializePackage(const char *path)
66: {
67: char logList[256];
68: char *className;
69: PetscBool opt;
70: PetscErrorCode ierr;
73: if (IPPackageInitialized) return(0);
74: IPPackageInitialized = PETSC_TRUE;
75: /* Register Classes */
76: PetscClassIdRegister("Inner product",&IP_CLASSID);
77: /* Register Constructors */
78: IPRegisterAll(path);
79: /* Register Events */
80: PetscLogEventRegister("IPOrthogonalize",IP_CLASSID,&IP_Orthogonalize);
81: PetscLogEventRegister("IPInnerProduct",IP_CLASSID,&IP_InnerProduct);
82: PetscLogEventRegister("IPApplyMatrix",IP_CLASSID,&IP_ApplyMatrix);
83: /* Process info exclusions */
84: PetscOptionsGetString(PETSC_NULL,"-info_exclude",logList,256,&opt);
85: if (opt) {
86: PetscStrstr(logList,"ip",&className);
87: if (className) {
88: PetscInfoDeactivateClass(IP_CLASSID);
89: }
90: }
91: /* Process summary exclusions */
92: PetscOptionsGetString(PETSC_NULL,"-log_summary_exclude",logList,256,&opt);
93: if (opt) {
94: PetscStrstr(logList,"ip",&className);
95: if (className) {
96: PetscLogEventDeactivateClass(IP_CLASSID);
97: }
98: }
99: PetscRegisterFinalize(IPFinalizePackage);
100: return(0);
101: }
105: /*@C
106: IPCreate - Creates an IP context.
108: Collective on MPI_Comm
110: Input Parameter:
111: . comm - MPI communicator
113: Output Parameter:
114: . newip - location to put the IP context
116: Level: beginner
118: Note:
119: IP objects are not intended for normal users but only for
120: advanced user that for instance implement their own solvers.
122: .seealso: IPDestroy(), IP
123: @*/
124: PetscErrorCode IPCreate(MPI_Comm comm,IP *newip)
125: {
126: IP ip;
131: SlepcHeaderCreate(ip,_p_IP,struct _IPOps,IP_CLASSID,-1,"IP","Inner Product","IP",comm,IPDestroy,IPView);
132: *newip = ip;
133: ip->orthog_type = IP_ORTHOG_CGS;
134: ip->orthog_ref = IP_ORTHOG_REFINE_IFNEEDED;
135: ip->orthog_eta = 0.7071;
136: ip->innerproducts = 0;
137: ip->matrix = PETSC_NULL;
138: ip->Bx = PETSC_NULL;
139: ip->xid = 0;
140: ip->xstate = 0;
141: return(0);
142: }
146: /*@C
147: IPSetOptionsPrefix - Sets the prefix used for searching for all
148: IP options in the database.
150: Logically Collective on IP
152: Input Parameters:
153: + ip - the innerproduct context
154: - prefix - the prefix string to prepend to all IP option requests
156: Notes:
157: A hyphen (-) must NOT be given at the beginning of the prefix name.
158: The first character of all runtime options is AUTOMATICALLY the
159: hyphen.
161: Level: advanced
163: .seealso: IPAppendOptionsPrefix()
164: @*/
165: PetscErrorCode IPSetOptionsPrefix(IP ip,const char *prefix)
166: {
171: PetscObjectSetOptionsPrefix((PetscObject)ip,prefix);
172: return(0);
173: }
177: /*@C
178: IPAppendOptionsPrefix - Appends to the prefix used for searching for all
179: IP options in the database.
181: Logically Collective on IP
183: Input Parameters:
184: + ip - the innerproduct context
185: - prefix - the prefix string to prepend to all IP option requests
187: Notes:
188: A hyphen (-) must NOT be given at the beginning of the prefix name.
189: The first character of all runtime options is AUTOMATICALLY the hyphen.
191: Level: advanced
193: .seealso: IPSetOptionsPrefix()
194: @*/
195: PetscErrorCode IPAppendOptionsPrefix(IP ip,const char *prefix)
196: {
201: PetscObjectAppendOptionsPrefix((PetscObject)ip,prefix);
202: return(0);
203: }
207: /*@C
208: IPGetOptionsPrefix - Gets the prefix used for searching for all
209: IP options in the database.
211: Not Collective
213: Input Parameters:
214: . ip - the innerproduct context
216: Output Parameters:
217: . prefix - pointer to the prefix string used is returned
219: Notes: On the fortran side, the user should pass in a string 'prefix' of
220: sufficient length to hold the prefix.
222: Level: advanced
224: .seealso: IPSetOptionsPrefix(), IPAppendOptionsPrefix()
225: @*/
226: PetscErrorCode IPGetOptionsPrefix(IP ip,const char *prefix[])
227: {
233: PetscObjectGetOptionsPrefix((PetscObject)ip,prefix);
234: return(0);
235: }
239: /*@C
240: IPSetType - Selects the type for the IP object.
242: Logically Collective on IP
244: Input Parameter:
245: + ip - the inner product context.
246: - type - a known type
248: Notes:
249: Three types are available: IPBILINEAR, IPSESQUILINEAR, and IPINDEFINITE.
251: For complex scalars, the default is a sesquilinear form (x,y)=x^H*M*y and it is
252: also possible to choose a bilinear form (x,y)=x^T*M*y (without complex conjugation).
253: The latter could be useful e.g. in complex-symmetric eigensolvers.
255: In the case of real scalars, only the bilinear form (x,y)=x^T*M*y is available.
257: The indefinite inner product is reserved for the case of an indefinite
258: matrix M. This is used for instance in symmetric-indefinite eigenproblems.
260: Level: advanced
262: .seealso: IPGetType()
264: @*/
265: PetscErrorCode IPSetType(IP ip,const IPType type)
266: {
267: PetscErrorCode ierr,(*r)(IP);
268: PetscBool match;
274: PetscObjectTypeCompare((PetscObject)ip,type,&match);
275: if (match) return(0);
277: PetscFListFind(IPList,((PetscObject)ip)->comm,type,PETSC_TRUE,(void (**)(void))&r);
278: if (!r) SETERRQ1(((PetscObject)ip)->comm,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested IP type %s",type);
280: PetscMemzero(ip->ops,sizeof(struct _IPOps));
282: PetscObjectChangeTypeName((PetscObject)ip,type);
283: (*r)(ip);
284: return(0);
285: }
289: /*@C
290: IPGetType - Gets the IP type name (as a string) from the IP context.
292: Not Collective
294: Input Parameter:
295: . ip - the inner product context
297: Output Parameter:
298: . name - name of the inner product
300: Level: advanced
302: .seealso: IPSetType()
304: @*/
305: PetscErrorCode IPGetType(IP ip,const IPType *type)
306: {
310: *type = ((PetscObject)ip)->type_name;
311: return(0);
312: }
316: /*
317: Sets the default IP type, depending on whether complex arithmetic
318: is used or not.
319: */
320: PetscErrorCode IPSetDefaultType_Private(IP ip)
321: {
326: #if defined(PETSC_USE_COMPLEX)
327: IPSetType(ip,IPSESQUILINEAR);
328: #else
329: IPSetType(ip,IPBILINEAR);
330: #endif
331: return(0);
332: }
336: /*@
337: IPSetFromOptions - Sets IP options from the options database.
339: Collective on IP
341: Input Parameters:
342: . ip - the innerproduct context
344: Notes:
345: To see all options, run your program with the -help option.
347: Level: beginner
348: @*/
349: PetscErrorCode IPSetFromOptions(IP ip)
350: {
351: const char *orth_list[2] = {"mgs","cgs"};
352: const char *ref_list[3] = {"never","ifneeded","always"};
353: PetscReal r;
354: PetscInt i,j;
359: if (!IPRegisterAllCalled) { IPRegisterAll(PETSC_NULL); }
360: /* Set default type (we do not allow changing it with -ip_type) */
361: if (!((PetscObject)ip)->type_name) {
362: IPSetDefaultType_Private(ip);
363: }
364: PetscOptionsBegin(((PetscObject)ip)->comm,((PetscObject)ip)->prefix,"Inner Product (IP) Options","IP");
365: i = ip->orthog_type;
366: PetscOptionsEList("-ip_orthog_type","Orthogonalization method","IPSetOrthogonalization",orth_list,2,orth_list[i],&i,PETSC_NULL);
367: j = ip->orthog_ref;
368: PetscOptionsEList("-ip_orthog_refine","Iterative refinement mode during orthogonalization","IPSetOrthogonalization",ref_list,3,ref_list[j],&j,PETSC_NULL);
369: r = ip->orthog_eta;
370: PetscOptionsReal("-ip_orthog_eta","Parameter of iterative refinement during orthogonalization","IPSetOrthogonalization",r,&r,PETSC_NULL);
371: IPSetOrthogonalization(ip,(IPOrthogType)i,(IPOrthogRefineType)j,r);
372: PetscObjectProcessOptionsHandlers((PetscObject)ip);
373: PetscOptionsEnd();
374: return(0);
375: }
379: /*@
380: IPSetOrthogonalization - Specifies the type of orthogonalization technique
381: to be used (classical or modified Gram-Schmidt with or without refinement).
383: Logically Collective on IP
385: Input Parameters:
386: + ip - the innerproduct context
387: . type - the type of orthogonalization technique
388: . refine - type of refinement
389: - eta - parameter for selective refinement
391: Options Database Keys:
392: + -orthog_type <type> - Where <type> is cgs for Classical Gram-Schmidt orthogonalization
393: (default) or mgs for Modified Gram-Schmidt orthogonalization
394: . -orthog_refine <type> - Where <type> is one of never, ifneeded (default) or always
395: - -orthog_eta <eta> - For setting the value of eta
396:
397: Notes:
398: The default settings work well for most problems.
400: The parameter eta should be a real value between 0 and 1 (or PETSC_DEFAULT).
401: The value of eta is used only when the refinement type is "ifneeded".
403: When using several processors, MGS is likely to result in bad scalability.
405: Level: advanced
407: .seealso: IPOrthogonalize(), IPGetOrthogonalization(), IPOrthogType,
408: IPOrthogRefineType
409: @*/
410: PetscErrorCode IPSetOrthogonalization(IP ip,IPOrthogType type,IPOrthogRefineType refine,PetscReal eta)
411: {
417: switch (type) {
418: case IP_ORTHOG_CGS:
419: case IP_ORTHOG_MGS:
420: ip->orthog_type = type;
421: break;
422: default:
423: SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type");
424: }
425: switch (refine) {
426: case IP_ORTHOG_REFINE_NEVER:
427: case IP_ORTHOG_REFINE_IFNEEDED:
428: case IP_ORTHOG_REFINE_ALWAYS:
429: ip->orthog_ref = refine;
430: break;
431: default:
432: SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown refinement type");
433: }
434: if (eta == PETSC_DEFAULT) {
435: ip->orthog_eta = 0.7071;
436: } else {
437: if (eta <= 0.0 || eta > 1.0) SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid eta value");
438: ip->orthog_eta = eta;
439: }
440: return(0);
441: }
445: /*@C
446: IPGetOrthogonalization - Gets the orthogonalization settings from the
447: IP object.
449: Not Collective
451: Input Parameter:
452: . ip - inner product context
454: Output Parameter:
455: + type - type of orthogonalization technique
456: . refine - type of refinement
457: - eta - parameter for selective refinement
459: Level: advanced
461: .seealso: IPOrthogonalize(), IPSetOrthogonalization(), IPOrthogType,
462: IPOrthogRefineType
463: @*/
464: PetscErrorCode IPGetOrthogonalization(IP ip,IPOrthogType *type,IPOrthogRefineType *refine,PetscReal *eta)
465: {
468: if (type) *type = ip->orthog_type;
469: if (refine) *refine = ip->orthog_ref;
470: if (eta) *eta = ip->orthog_eta;
471: return(0);
472: }
476: /*@C
477: IPView - Prints the IP data structure.
479: Collective on IP
481: Input Parameters:
482: + ip - the innerproduct context
483: - viewer - optional visualization context
485: Note:
486: The available visualization contexts include
487: + PETSC_VIEWER_STDOUT_SELF - standard output (default)
488: - PETSC_VIEWER_STDOUT_WORLD - synchronized standard
489: output where only the first processor opens
490: the file. All other processors send their
491: data to the first processor to print.
493: The user can open an alternative visualization context with
494: PetscViewerASCIIOpen() - output to a specified file.
496: Level: beginner
498: .seealso: EPSView(), SVDView(), PetscViewerASCIIOpen()
499: @*/
500: PetscErrorCode IPView(IP ip,PetscViewer viewer)
501: {
502: PetscBool isascii;
507: if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)ip)->comm);
510: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
511: if (isascii) {
512: PetscObjectPrintClassNamePrefixType((PetscObject)ip,viewer,"IP Object");
513: PetscViewerASCIIPrintf(viewer," orthogonalization method: ");
514: switch (ip->orthog_type) {
515: case IP_ORTHOG_MGS:
516: PetscViewerASCIIPrintf(viewer,"modified Gram-Schmidt\n");
517: break;
518: case IP_ORTHOG_CGS:
519: PetscViewerASCIIPrintf(viewer,"classical Gram-Schmidt\n");
520: break;
521: default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_type");
522: }
523: PetscViewerASCIIPrintf(viewer," orthogonalization refinement: ");
524: switch (ip->orthog_ref) {
525: case IP_ORTHOG_REFINE_NEVER:
526: PetscViewerASCIIPrintf(viewer,"never\n");
527: break;
528: case IP_ORTHOG_REFINE_IFNEEDED:
529: PetscViewerASCIIPrintf(viewer,"if needed (eta: %G)\n",ip->orthog_eta);
530: break;
531: case IP_ORTHOG_REFINE_ALWAYS:
532: PetscViewerASCIIPrintf(viewer,"always\n");
533: break;
534: default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_ref");
535: }
536: if (ip->matrix) {
537: PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO);
538: PetscViewerASCIIPushTab(viewer);
539: MatView(ip->matrix,viewer);
540: PetscViewerASCIIPopTab(viewer);
541: PetscViewerPopFormat(viewer);
542: }
543: } else SETERRQ1(((PetscObject)ip)->comm,1,"Viewer type %s not supported for IP",((PetscObject)viewer)->type_name);
544: return(0);
545: }
549: /*@
550: IPReset - Resets the IP context to the initial state.
552: Collective on IP
554: Input Parameter:
555: . ip - the inner product context
557: Level: advanced
559: .seealso: IPDestroy()
560: @*/
561: PetscErrorCode IPReset(IP ip)
562: {
567: MatDestroy(&ip->matrix);
568: VecDestroy(&ip->Bx);
569: ip->xid = 0;
570: ip->xstate = 0;
571: IPResetOperationCounters(ip);
572: return(0);
573: }
577: /*@C
578: IPDestroy - Destroys IP context that was created with IPCreate().
580: Collective on IP
582: Input Parameter:
583: . ip - the inner product context
585: Level: beginner
587: .seealso: IPCreate()
588: @*/
589: PetscErrorCode IPDestroy(IP *ip)
590: {
594: if (!*ip) return(0);
596: if (--((PetscObject)(*ip))->refct > 0) { *ip = 0; return(0); }
597: IPReset(*ip);
598: PetscHeaderDestroy(ip);
599: return(0);
600: }
604: /*@
605: IPGetOperationCounters - Gets the total number of inner product operations
606: made by the IP object.
608: Not Collective
610: Input Parameter:
611: . ip - the inner product context
613: Output Parameter:
614: . dots - number of inner product operations
615:
616: Level: intermediate
618: .seealso: IPResetOperationCounters()
619: @*/
620: PetscErrorCode IPGetOperationCounters(IP ip,PetscInt *dots)
621: {
625: *dots = ip->innerproducts;
626: return(0);
627: }
631: /*@
632: IPResetOperationCounters - Resets the counters for inner product operations
633: made by of the IP object.
635: Logically Collective on IP
637: Input Parameter:
638: . ip - the inner product context
640: Level: intermediate
642: .seealso: IPGetOperationCounters()
643: @*/
644: PetscErrorCode IPResetOperationCounters(IP ip)
645: {
648: ip->innerproducts = 0;
649: return(0);
650: }
654: /*@C
655: IPRegister - See IPRegisterDynamic()
657: Level: advanced
658: @*/
659: PetscErrorCode IPRegister(const char *sname,const char *path,const char *name,PetscErrorCode (*function)(IP))
660: {
662: char fullname[PETSC_MAX_PATH_LEN];
665: PetscFListConcat(path,name,fullname);
666: PetscFListAdd(&IPList,sname,fullname,(void (*)(void))function);
667: return(0);
668: }
672: /*@
673: IPRegisterDestroy - Frees the list of IP methods that were
674: registered by IPRegisterDynamic().
676: Not Collective
678: Level: advanced
680: .seealso: IPRegisterDynamic(), IPRegisterAll()
681: @*/
682: PetscErrorCode IPRegisterDestroy(void)
683: {
687: PetscFListDestroy(&IPList);
688: IPRegisterAllCalled = PETSC_FALSE;
689: return(0);
690: }
692: EXTERN_C_BEGIN
693: extern PetscErrorCode IPCreate_Bilinear(IP);
694: #if defined(PETSC_USE_COMPLEX)
695: extern PetscErrorCode IPCreate_Sesquilinear(IP);
696: #endif
697: extern PetscErrorCode IPCreate_Indefinite(IP);
698: EXTERN_C_END
702: /*@C
703: IPRegisterAll - Registers all of the inner products in the IP package.
705: Not Collective
707: Input Parameter:
708: . path - the library where the routines are to be found (optional)
710: Level: advanced
711: @*/
712: PetscErrorCode IPRegisterAll(const char *path)
713: {
717: IPRegisterAllCalled = PETSC_TRUE;
718: IPRegisterDynamic(IPBILINEAR,path,"IPCreate_Bilinear",IPCreate_Bilinear);
719: #if defined(PETSC_USE_COMPLEX)
720: IPRegisterDynamic(IPSESQUILINEAR,path,"IPCreate_Sesquilinear",IPCreate_Sesquilinear);
721: #endif
722: IPRegisterDynamic(IPINDEFINITE,path,"IPCreate_Indefinite",IPCreate_Indefinite);
723: return(0);
724: }