Actual source code: ipbasic.c

  1: /*
  2:      Basic routines

  4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  6:    Copyright (c) 2002-2011, 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 <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:   PetscHeaderCreate(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:    Two types are available: IPBILINEAR and IPSESQUILINEAR.

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:    Level: advanced

259: .seealso: IPGetType()

261: @*/
262: PetscErrorCode IPSetType(IP ip,const IPType type)
263: {
264:   PetscErrorCode ierr,(*r)(IP);
265:   PetscBool      match;


271:   PetscTypeCompare((PetscObject)ip,type,&match);
272:   if (match) return(0);

274:    PetscFListFind(IPList,((PetscObject)ip)->comm,type,PETSC_TRUE,(void (**)(void))&r);
275:   if (!r) SETERRQ1(((PetscObject)ip)->comm,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested IP type %s",type);

277:   PetscMemzero(ip->ops,sizeof(struct _IPOps));

279:   PetscObjectChangeTypeName((PetscObject)ip,type);
280:   (*r)(ip);
281:   return(0);
282: }

286: /*@C
287:    IPGetType - Gets the IP type name (as a string) from the IP context.

289:    Not Collective

291:    Input Parameter:
292: .  ip - the inner product context

294:    Output Parameter:
295: .  name - name of the inner product

297:    Level: advanced

299: .seealso: IPSetType()

301: @*/
302: PetscErrorCode IPGetType(IP ip,const IPType *type)
303: {
307:   *type = ((PetscObject)ip)->type_name;
308:   return(0);
309: }

313: /*
314:   Sets the default IP type, depending on whether complex arithmetic
315:   is used or not.
316: */
317: PetscErrorCode IPSetDefaultType_Private(IP ip)
318: {

323: #if defined(PETSC_USE_COMPLEX)
324:   IPSetType(ip,IPSESQUILINEAR);
325: #else
326:   IPSetType(ip,IPBILINEAR);
327: #endif
328:   return(0);
329: }

333: /*@
334:    IPSetFromOptions - Sets IP options from the options database.

336:    Collective on IP

338:    Input Parameters:
339: .  ip - the innerproduct context

341:    Notes:  
342:    To see all options, run your program with the -help option.

344:    Level: beginner
345: @*/
346: PetscErrorCode IPSetFromOptions(IP ip)
347: {
348:   const char     *orth_list[2] = {"mgs","cgs"};
349:   const char     *ref_list[3] = {"never","ifneeded","always"};
350:   PetscReal      r;
351:   PetscInt       i,j;

356:   if (!IPRegisterAllCalled) { IPRegisterAll(PETSC_NULL); }
357:   /* Set default type (we do not allow changing it with -ip_type) */
358:   if (!((PetscObject)ip)->type_name) {
359:     IPSetDefaultType_Private(ip);
360:   }
361:   PetscOptionsBegin(((PetscObject)ip)->comm,((PetscObject)ip)->prefix,"Inner Product (IP) Options","IP");
362:     i = ip->orthog_type;
363:     PetscOptionsEList("-ip_orthog_type","Orthogonalization method","IPSetOrthogonalization",orth_list,2,orth_list[i],&i,PETSC_NULL);
364:     j = ip->orthog_ref;
365:     PetscOptionsEList("-ip_orthog_refine","Iterative refinement mode during orthogonalization","IPSetOrthogonalization",ref_list,3,ref_list[j],&j,PETSC_NULL);
366:     r = ip->orthog_eta;
367:     PetscOptionsReal("-ip_orthog_eta","Parameter of iterative refinement during orthogonalization","IPSetOrthogonalization",r,&r,PETSC_NULL);
368:     IPSetOrthogonalization(ip,(IPOrthogType)i,(IPOrthogRefineType)j,r);
369:     PetscObjectProcessOptionsHandlers((PetscObject)ip);
370:   PetscOptionsEnd();
371:   return(0);
372: }

376: /*@
377:    IPSetOrthogonalization - Specifies the type of orthogonalization technique
378:    to be used (classical or modified Gram-Schmidt with or without refinement).

380:    Logically Collective on IP

382:    Input Parameters:
383: +  ip     - the innerproduct context
384: .  type   - the type of orthogonalization technique
385: .  refine - type of refinement
386: -  eta    - parameter for selective refinement

388:    Options Database Keys:
389: +  -orthog_type <type> - Where <type> is cgs for Classical Gram-Schmidt orthogonalization
390:                          (default) or mgs for Modified Gram-Schmidt orthogonalization
391: .  -orthog_refine <type> - Where <type> is one of never, ifneeded (default) or always 
392: -  -orthog_eta <eta> -  For setting the value of eta
393:     
394:    Notes:  
395:    The default settings work well for most problems. 

397:    The parameter eta should be a real value between 0 and 1 (or PETSC_DEFAULT).
398:    The value of eta is used only when the refinement type is "ifneeded". 

400:    When using several processors, MGS is likely to result in bad scalability.

402:    Level: advanced

404: .seealso: IPOrthogonalize(), IPGetOrthogonalization(), IPOrthogType,
405:           IPOrthogRefineType
406: @*/
407: PetscErrorCode IPSetOrthogonalization(IP ip,IPOrthogType type,IPOrthogRefineType refine,PetscReal eta)
408: {
414:   switch (type) {
415:     case IP_ORTHOG_CGS:
416:     case IP_ORTHOG_MGS:
417:       ip->orthog_type = type;
418:       break;
419:     default:
420:       SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type");
421:   }
422:   switch (refine) {
423:     case IP_ORTHOG_REFINE_NEVER:
424:     case IP_ORTHOG_REFINE_IFNEEDED:
425:     case IP_ORTHOG_REFINE_ALWAYS:
426:       ip->orthog_ref = refine;
427:       break;
428:     default:
429:       SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown refinement type");
430:   }
431:   if (eta == PETSC_DEFAULT) {
432:     ip->orthog_eta = 0.7071;
433:   } else {
434:     if (eta <= 0.0 || eta > 1.0) SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid eta value");
435:     ip->orthog_eta = eta;
436:   }
437:   return(0);
438: }

442: /*@C
443:    IPGetOrthogonalization - Gets the orthogonalization settings from the 
444:    IP object.

446:    Not Collective

448:    Input Parameter:
449: .  ip - inner product context 

451:    Output Parameter:
452: +  type   - type of orthogonalization technique
453: .  refine - type of refinement
454: -  eta    - parameter for selective refinement

456:    Level: advanced

458: .seealso: IPOrthogonalize(), IPSetOrthogonalization(), IPOrthogType,
459:           IPOrthogRefineType
460: @*/
461: PetscErrorCode IPGetOrthogonalization(IP ip,IPOrthogType *type,IPOrthogRefineType *refine,PetscReal *eta)
462: {
465:   if (type)   *type   = ip->orthog_type;
466:   if (refine) *refine = ip->orthog_ref;
467:   if (eta)    *eta    = ip->orthog_eta;
468:   return(0);
469: }

473: /*@C
474:    IPView - Prints the IP data structure.

476:    Collective on IP

478:    Input Parameters:
479: +  ip - the innerproduct context
480: -  viewer - optional visualization context

482:    Note:
483:    The available visualization contexts include
484: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
485: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
486:          output where only the first processor opens
487:          the file.  All other processors send their 
488:          data to the first processor to print. 

490:    The user can open an alternative visualization context with
491:    PetscViewerASCIIOpen() - output to a specified file.

493:    Level: beginner

495: .seealso: EPSView(), SVDView(), PetscViewerASCIIOpen()
496: @*/
497: PetscErrorCode IPView(IP ip,PetscViewer viewer)
498: {
499:   PetscBool      isascii;

504:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)ip)->comm);
507:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
508:   if (isascii) {
509:     PetscObjectPrintClassNamePrefixType((PetscObject)ip,viewer,"IP Object");
510:     PetscViewerASCIIPrintf(viewer,"  orthogonalization method: ");
511:     switch (ip->orthog_type) {
512:       case IP_ORTHOG_MGS:
513:         PetscViewerASCIIPrintf(viewer,"modified Gram-Schmidt\n");
514:         break;
515:       case IP_ORTHOG_CGS:
516:         PetscViewerASCIIPrintf(viewer,"classical Gram-Schmidt\n");
517:         break;
518:       default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_type");
519:     }
520:     PetscViewerASCIIPrintf(viewer,"  orthogonalization refinement: ");
521:     switch (ip->orthog_ref) {
522:       case IP_ORTHOG_REFINE_NEVER:
523:         PetscViewerASCIIPrintf(viewer,"never\n");
524:         break;
525:       case IP_ORTHOG_REFINE_IFNEEDED:
526:         PetscViewerASCIIPrintf(viewer,"if needed (eta: %G)\n",ip->orthog_eta);
527:         break;
528:       case IP_ORTHOG_REFINE_ALWAYS:
529:         PetscViewerASCIIPrintf(viewer,"always\n");
530:         break;
531:       default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_ref");
532:     }
533:     if (ip->matrix) {
534:       PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO);
535:       PetscViewerASCIIPushTab(viewer);
536:       MatView(ip->matrix,viewer);
537:       PetscViewerASCIIPopTab(viewer);
538:       PetscViewerPopFormat(viewer);
539:     }
540:   } else {
541:     SETERRQ1(((PetscObject)ip)->comm,1,"Viewer type %s not supported for IP",((PetscObject)viewer)->type_name);
542:   }
543:   return(0);
544: }

548: /*@C
549:    IPReset - Resets the IP context to the initial state.

551:    Collective on IP

553:    Input Parameter:
554: .  ip - the inner product context

556:    Level: advanced

558: .seealso: IPDestroy()
559: @*/
560: PetscErrorCode IPReset(IP ip)
561: {

566:   MatDestroy(&ip->matrix);
567:   VecDestroy(&ip->Bx);
568:   ip->xid    = 0;
569:   ip->xstate = 0;
570:   IPResetOperationCounters(ip);
571:   return(0);
572: }

576: /*@C
577:    IPDestroy - Destroys IP context that was created with IPCreate().

579:    Collective on IP

581:    Input Parameter:
582: .  ip - the inner product context

584:    Level: beginner

586: .seealso: IPCreate()
587: @*/
588: PetscErrorCode IPDestroy(IP *ip)
589: {

593:   if (!*ip) return(0);
595:   if (--((PetscObject)(*ip))->refct > 0) { *ip = 0; return(0); }
596:   IPReset(*ip);
597:   PetscHeaderDestroy(ip);
598:   return(0);
599: }

603: /*@
604:    IPGetOperationCounters - Gets the total number of inner product operations 
605:    made by the IP object.

607:    Not Collective

609:    Input Parameter:
610: .  ip - the inner product context

612:    Output Parameter:
613: .  dots - number of inner product operations
614:    
615:    Level: intermediate

617: .seealso: IPResetOperationCounters()
618: @*/
619: PetscErrorCode IPGetOperationCounters(IP ip,PetscInt *dots)
620: {
624:   *dots = ip->innerproducts;
625:   return(0);
626: }

630: /*@
631:    IPResetOperationCounters - Resets the counters for inner product operations 
632:    made by of the IP object.

634:    Logically Collective on IP

636:    Input Parameter:
637: .  ip - the inner product context

639:    Level: intermediate

641: .seealso: IPGetOperationCounters()
642: @*/
643: PetscErrorCode IPResetOperationCounters(IP ip)
644: {
647:   ip->innerproducts = 0;
648:   return(0);
649: }

653: /*@C
654:    IPRegister - See IPRegisterDynamic()

656:    Level: advanced
657: @*/
658: PetscErrorCode IPRegister(const char *sname,const char *path,const char *name,PetscErrorCode (*function)(IP))
659: {
661:   char           fullname[PETSC_MAX_PATH_LEN];

664:   PetscFListConcat(path,name,fullname);
665:   PetscFListAdd(&IPList,sname,fullname,(void (*)(void))function);
666:   return(0);
667: }

671: /*@
672:    IPRegisterDestroy - Frees the list of IP methods that were
673:    registered by IPRegisterDynamic().

675:    Not Collective

677:    Level: advanced

679: .seealso: IPRegisterDynamic(), IPRegisterAll()
680: @*/
681: PetscErrorCode IPRegisterDestroy(void)
682: {

686:   PetscFListDestroy(&IPList);
687:   IPRegisterAllCalled = PETSC_FALSE;
688:   return(0);
689: }

691: EXTERN_C_BEGIN
692: extern PetscErrorCode IPCreate_Bilinear(IP);
693: #if defined(PETSC_USE_COMPLEX)
694: extern PetscErrorCode IPCreate_Sesquilinear(IP);
695: #endif
696: EXTERN_C_END

700: /*@C
701:    IPRegisterAll - Registers all of the inner products in the IP package.

703:    Not Collective

705:    Input Parameter:
706: .  path - the library where the routines are to be found (optional)

708:    Level: advanced
709: @*/
710: PetscErrorCode IPRegisterAll(const char *path)
711: {

715:   IPRegisterAllCalled = PETSC_TRUE;
716:   IPRegisterDynamic(IPBILINEAR,path,"IPCreate_Bilinear",IPCreate_Bilinear);
717: #if defined(PETSC_USE_COMPLEX)
718:   IPRegisterDynamic(IPSESQUILINEAR,path,"IPCreate_Sesquilinear",IPCreate_Sesquilinear);
719: #endif
720:   return(0);
721: }