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: }