Actual source code: ipbasic.c

  1: /*
  2:      Basic routines

  4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  6:    Copyright (c) 2002-2013, 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/ipimpl.h>      /*I "slepcip.h" I*/

 26: PetscFunctionList 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: {

 47:   PetscFunctionListDestroy(&IPList);
 48:   IPPackageInitialized = PETSC_FALSE;
 49:   IPRegisterAllCalled  = PETSC_FALSE;
 50:   return(0);
 51: }

 55: /*@C
 56:   IPInitializePackage - This function initializes everything in the IP package. It is called
 57:   from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to IPCreate()
 58:   when using static libraries.

 60:   Level: developer

 62: .seealso: SlepcInitialize()
 63: @*/
 64: PetscErrorCode IPInitializePackage(void)
 65: {
 66:   char             logList[256];
 67:   char             *className;
 68:   PetscBool        opt;
 69:   PetscErrorCode   ierr;

 72:   if (IPPackageInitialized) return(0);
 73:   IPPackageInitialized = PETSC_TRUE;
 74:   /* Register Classes */
 75:   PetscClassIdRegister("Inner product",&IP_CLASSID);
 76:   /* Register Constructors */
 77:   IPRegisterAll();
 78:   /* Register Events */
 79:   PetscLogEventRegister("IPOrthogonalize",IP_CLASSID,&IP_Orthogonalize);
 80:   PetscLogEventRegister("IPInnerProduct",IP_CLASSID,&IP_InnerProduct);
 81:   PetscLogEventRegister("IPApplyMatrix",IP_CLASSID,&IP_ApplyMatrix);
 82:   /* Process info exclusions */
 83:   PetscOptionsGetString(NULL,"-info_exclude",logList,256,&opt);
 84:   if (opt) {
 85:     PetscStrstr(logList,"ip",&className);
 86:     if (className) {
 87:       PetscInfoDeactivateClass(IP_CLASSID);
 88:     }
 89:   }
 90:   /* Process summary exclusions */
 91:   PetscOptionsGetString(NULL,"-log_summary_exclude",logList,256,&opt);
 92:   if (opt) {
 93:     PetscStrstr(logList,"ip",&className);
 94:     if (className) {
 95:       PetscLogEventDeactivateClass(IP_CLASSID);
 96:     }
 97:   }
 98:   PetscRegisterFinalize(IPFinalizePackage);
 99:   return(0);
100: }

104: /*@C
105:    IPCreate - Creates an IP context.

107:    Collective on MPI_Comm

109:    Input Parameter:
110: .  comm - MPI communicator

112:    Output Parameter:
113: .  newip - location to put the IP context

115:    Level: beginner

117:    Note:
118:    IP objects are not intended for normal users but only for
119:    advanced user that for instance implement their own solvers.

121: .seealso: IPDestroy(), IP
122: @*/
123: PetscErrorCode IPCreate(MPI_Comm comm,IP *newip)
124: {
125:   IP             ip;

130:   *newip = 0;
131: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
132:   IPInitializePackage();
133: #endif

135:   SlepcHeaderCreate(ip,_p_IP,struct _IPOps,IP_CLASSID,"IP","Inner Product","IP",comm,IPDestroy,IPView);

137:   ip->orthog_type   = IP_ORTHOG_CGS;
138:   ip->orthog_ref    = IP_ORTHOG_REFINE_IFNEEDED;
139:   ip->orthog_eta    = 0.7071;
140:   ip->innerproducts = 0;
141:   ip->matrix        = NULL;
142:   ip->Bx            = NULL;
143:   ip->xid           = 0;
144:   ip->xstate        = 0;
145:   ip->work          = NULL;
146:   ip->lwork         = 0;

148:   *newip = ip;
149:   return(0);
150: }

154: /*@C
155:    IPSetOptionsPrefix - Sets the prefix used for searching for all
156:    IP options in the database.

158:    Logically Collective on IP

160:    Input Parameters:
161: +  ip - the inner product context
162: -  prefix - the prefix string to prepend to all IP option requests

164:    Notes:
165:    A hyphen (-) must NOT be given at the beginning of the prefix name.
166:    The first character of all runtime options is AUTOMATICALLY the
167:    hyphen.

169:    Level: advanced

171: .seealso: IPAppendOptionsPrefix()
172: @*/
173: PetscErrorCode IPSetOptionsPrefix(IP ip,const char *prefix)
174: {

179:   PetscObjectSetOptionsPrefix((PetscObject)ip,prefix);
180:   return(0);
181: }

185: /*@C
186:    IPAppendOptionsPrefix - Appends to the prefix used for searching for all
187:    IP options in the database.

189:    Logically Collective on IP

191:    Input Parameters:
192: +  ip - the inner product context
193: -  prefix - the prefix string to prepend to all IP option requests

195:    Notes:
196:    A hyphen (-) must NOT be given at the beginning of the prefix name.
197:    The first character of all runtime options is AUTOMATICALLY the hyphen.

199:    Level: advanced

201: .seealso: IPSetOptionsPrefix()
202: @*/
203: PetscErrorCode IPAppendOptionsPrefix(IP ip,const char *prefix)
204: {

209:   PetscObjectAppendOptionsPrefix((PetscObject)ip,prefix);
210:   return(0);
211: }

215: /*@C
216:    IPGetOptionsPrefix - Gets the prefix used for searching for all
217:    IP options in the database.

219:    Not Collective

221:    Input Parameters:
222: .  ip - the inner product context

224:    Output Parameters:
225: .  prefix - pointer to the prefix string used is returned

227:    Notes: On the fortran side, the user should pass in a string 'prefix' of
228:    sufficient length to hold the prefix.

230:    Level: advanced

232: .seealso: IPSetOptionsPrefix(), IPAppendOptionsPrefix()
233: @*/
234: PetscErrorCode IPGetOptionsPrefix(IP ip,const char *prefix[])
235: {

241:   PetscObjectGetOptionsPrefix((PetscObject)ip,prefix);
242:   return(0);
243: }

247: /*@C
248:    IPSetType - Selects the type for the IP object.

250:    Logically Collective on IP

252:    Input Parameter:
253: +  ip   - the inner product context
254: -  type - a known type

256:    Notes:
257:    Three types are available: IPBILINEAR, IPSESQUILINEAR, and IPINDEFINITE.

259:    For complex scalars, the default is a sesquilinear form (x,y)=x^H*M*y and it is
260:    also possible to choose a bilinear form (x,y)=x^T*M*y (without complex conjugation).
261:    The latter could be useful e.g. in complex-symmetric eigensolvers.

263:    In the case of real scalars, only the bilinear form (x,y)=x^T*M*y is available.

265:    The indefinite inner product is reserved for the case of an indefinite
266:    matrix M. This is used for instance in symmetric-indefinite eigenproblems.

268:    Level: advanced

270: .seealso: IPGetType()
271: @*/
272: PetscErrorCode IPSetType(IP ip,IPType type)
273: {
274:   PetscErrorCode ierr,(*r)(IP);
275:   PetscBool      match;


281:   PetscObjectTypeCompare((PetscObject)ip,type,&match);
282:   if (match) return(0);

284:    PetscFunctionListFind(IPList,type,&r);
285:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)ip),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested IP type %s",type);

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

289:   PetscObjectChangeTypeName((PetscObject)ip,type);
290:   (*r)(ip);
291:   return(0);
292: }

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

299:    Not Collective

301:    Input Parameter:
302: .  ip - the inner product context

304:    Output Parameter:
305: .  name - name of the inner product

307:    Level: advanced

309: .seealso: IPSetType()
310: @*/
311: PetscErrorCode IPGetType(IP ip,IPType *type)
312: {
316:   *type = ((PetscObject)ip)->type_name;
317:   return(0);
318: }

322: /*
323:   Sets the default IP type, depending on whether complex arithmetic
324:   is used or not.
325: */
326: PetscErrorCode IPSetType_Default(IP ip)
327: {

332: #if defined(PETSC_USE_COMPLEX)
333:   IPSetType(ip,IPSESQUILINEAR);
334: #else
335:   IPSetType(ip,IPBILINEAR);
336: #endif
337:   return(0);
338: }

342: /*@
343:    IPSetFromOptions - Sets IP options from the options database.

345:    Collective on IP

347:    Input Parameters:
348: .  ip - the inner product context

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

353:    Level: beginner
354: @*/
355: PetscErrorCode IPSetFromOptions(IP ip)
356: {
357:   const char     *orth_list[2] = {"mgs","cgs"};
358:   const char     *ref_list[3] = {"never","ifneeded","always"};
359:   PetscReal      r;
360:   PetscInt       i,j;

365:   if (!IPRegisterAllCalled) { IPRegisterAll(); }
366:   /* Set default type (we do not allow changing it with -ip_type) */
367:   if (!((PetscObject)ip)->type_name) {
368:     IPSetType_Default(ip);
369:   }
370:   PetscObjectOptionsBegin((PetscObject)ip);
371:     i = ip->orthog_type;
372:     PetscOptionsEList("-ip_orthog_type","Orthogonalization method","IPSetOrthogonalization",orth_list,2,orth_list[i],&i,NULL);
373:     j = ip->orthog_ref;
374:     PetscOptionsEList("-ip_orthog_refine","Iterative refinement mode during orthogonalization","IPSetOrthogonalization",ref_list,3,ref_list[j],&j,NULL);
375:     r = ip->orthog_eta;
376:     PetscOptionsReal("-ip_orthog_eta","Parameter of iterative refinement during orthogonalization","IPSetOrthogonalization",r,&r,NULL);
377:     IPSetOrthogonalization(ip,(IPOrthogType)i,(IPOrthogRefineType)j,r);
378:     PetscObjectProcessOptionsHandlers((PetscObject)ip);
379:   PetscOptionsEnd();
380:   return(0);
381: }

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

389:    Logically Collective on IP

391:    Input Parameters:
392: +  ip     - the inner product context
393: .  type   - the type of orthogonalization technique
394: .  refine - type of refinement
395: -  eta    - parameter for selective refinement

397:    Options Database Keys:
398: +  -orthog_type <type> - Where <type> is cgs for Classical Gram-Schmidt orthogonalization
399:                          (default) or mgs for Modified Gram-Schmidt orthogonalization
400: .  -orthog_refine <type> - Where <type> is one of never, ifneeded (default) or always
401: -  -orthog_eta <eta> -  For setting the value of eta

403:    Notes:
404:    The default settings work well for most problems.

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

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

411:    Level: advanced

413: .seealso: IPOrthogonalize(), IPGetOrthogonalization(), IPOrthogType,
414:           IPOrthogRefineType
415: @*/
416: PetscErrorCode IPSetOrthogonalization(IP ip,IPOrthogType type,IPOrthogRefineType refine,PetscReal eta)
417: {
423:   switch (type) {
424:     case IP_ORTHOG_CGS:
425:     case IP_ORTHOG_MGS:
426:       ip->orthog_type = type;
427:       break;
428:     default:
429:       SETERRQ(PetscObjectComm((PetscObject)ip),PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type");
430:   }
431:   switch (refine) {
432:     case IP_ORTHOG_REFINE_NEVER:
433:     case IP_ORTHOG_REFINE_IFNEEDED:
434:     case IP_ORTHOG_REFINE_ALWAYS:
435:       ip->orthog_ref = refine;
436:       break;
437:     default:
438:       SETERRQ(PetscObjectComm((PetscObject)ip),PETSC_ERR_ARG_WRONG,"Unknown refinement type");
439:   }
440:   if (eta == PETSC_DEFAULT) {
441:     ip->orthog_eta = 0.7071;
442:   } else {
443:     if (eta <= 0.0 || eta > 1.0) SETERRQ(PetscObjectComm((PetscObject)ip),PETSC_ERR_ARG_OUTOFRANGE,"Invalid eta value");
444:     ip->orthog_eta = eta;
445:   }
446:   return(0);
447: }

451: /*@C
452:    IPGetOrthogonalization - Gets the orthogonalization settings from the
453:    IP object.

455:    Not Collective

457:    Input Parameter:
458: .  ip - inner product context

460:    Output Parameter:
461: +  type   - type of orthogonalization technique
462: .  refine - type of refinement
463: -  eta    - parameter for selective refinement

465:    Level: advanced

467: .seealso: IPOrthogonalize(), IPSetOrthogonalization(), IPOrthogType,
468:           IPOrthogRefineType
469: @*/
470: PetscErrorCode IPGetOrthogonalization(IP ip,IPOrthogType *type,IPOrthogRefineType *refine,PetscReal *eta)
471: {
474:   if (type)   *type   = ip->orthog_type;
475:   if (refine) *refine = ip->orthog_ref;
476:   if (eta)    *eta    = ip->orthog_eta;
477:   return(0);
478: }

482: /*@C
483:    IPView - Prints the IP data structure.

485:    Collective on IP

487:    Input Parameters:
488: +  ip - the inner product context
489: -  viewer - optional visualization context

491:    Note:
492:    The available visualization contexts include
493: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
494: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
495:          output where only the first processor opens
496:          the file.  All other processors send their
497:          data to the first processor to print.

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

502:    Level: beginner

504: .seealso: EPSView(), SVDView(), PetscViewerASCIIOpen()
505: @*/
506: PetscErrorCode IPView(IP ip,PetscViewer viewer)
507: {
508:   PetscBool      isascii;

513:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)ip));
516:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
517:   if (isascii) {
518:     PetscObjectPrintClassNamePrefixType((PetscObject)ip,viewer,"IP Object");
519:     PetscViewerASCIIPrintf(viewer,"  orthogonalization method: ");
520:     switch (ip->orthog_type) {
521:       case IP_ORTHOG_MGS:
522:         PetscViewerASCIIPrintf(viewer,"modified Gram-Schmidt\n");
523:         break;
524:       case IP_ORTHOG_CGS:
525:         PetscViewerASCIIPrintf(viewer,"classical Gram-Schmidt\n");
526:         break;
527:       default: SETERRQ(PetscObjectComm((PetscObject)ip),1,"Wrong value of ip->orth_type");
528:     }
529:     PetscViewerASCIIPrintf(viewer,"  orthogonalization refinement: ");
530:     switch (ip->orthog_ref) {
531:       case IP_ORTHOG_REFINE_NEVER:
532:         PetscViewerASCIIPrintf(viewer,"never\n");
533:         break;
534:       case IP_ORTHOG_REFINE_IFNEEDED:
535:         PetscViewerASCIIPrintf(viewer,"if needed (eta: %G)\n",ip->orthog_eta);
536:         break;
537:       case IP_ORTHOG_REFINE_ALWAYS:
538:         PetscViewerASCIIPrintf(viewer,"always\n");
539:         break;
540:       default: SETERRQ(PetscObjectComm((PetscObject)ip),1,"Wrong value of ip->orth_ref");
541:     }
542:     if (ip->matrix) {
543:       PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO);
544:       PetscViewerASCIIPushTab(viewer);
545:       MatView(ip->matrix,viewer);
546:       PetscViewerASCIIPopTab(viewer);
547:       PetscViewerPopFormat(viewer);
548:     }
549:   }
550:   return(0);
551: }

555: /*@
556:    IPReset - Resets the IP context to the initial state.

558:    Collective on IP

560:    Input Parameter:
561: .  ip - the inner product context

563:    Level: advanced

565: .seealso: IPDestroy()
566: @*/
567: PetscErrorCode IPReset(IP ip)
568: {

573:   MatDestroy(&ip->matrix);
574:   VecDestroy(&ip->Bx);
575:   ip->xid    = 0;
576:   ip->xstate = 0;
577:   PetscFree(ip->work);
578:   ip->lwork  = 0;
579:   IPResetOperationCounters(ip);
580:   return(0);
581: }

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

588:    Collective on IP

590:    Input Parameter:
591: .  ip - the inner product context

593:    Level: beginner

595: .seealso: IPCreate()
596: @*/
597: PetscErrorCode IPDestroy(IP *ip)
598: {

602:   if (!*ip) return(0);
604:   if (--((PetscObject)(*ip))->refct > 0) { *ip = 0; return(0); }
605:   IPReset(*ip);
606:   PetscHeaderDestroy(ip);
607:   return(0);
608: }

612: /*@
613:    IPGetOperationCounters - Gets the total number of inner product operations
614:    made by the IP object.

616:    Not Collective

618:    Input Parameter:
619: .  ip - the inner product context

621:    Output Parameter:
622: .  dots - number of inner product operations

624:    Level: intermediate

626: .seealso: IPResetOperationCounters()
627: @*/
628: PetscErrorCode IPGetOperationCounters(IP ip,PetscInt *dots)
629: {
633:   *dots = ip->innerproducts;
634:   return(0);
635: }

639: /*@
640:    IPResetOperationCounters - Resets the counters for inner product operations
641:    made by of the IP object.

643:    Logically Collective on IP

645:    Input Parameter:
646: .  ip - the inner product context

648:    Level: intermediate

650: .seealso: IPGetOperationCounters()
651: @*/
652: PetscErrorCode IPResetOperationCounters(IP ip)
653: {
656:   ip->innerproducts = 0;
657:   return(0);
658: }

662: /*@C
663:    IPRegister - Adds an inner product to the IP package.

665:    Not collective

667:    Input Parameters:
668: +  name - name of a new user-defined IP
669: -  function - routine to create context

671:    Notes:
672:    IPRegister() may be called multiple times to add several user-defined inner products.

674:    Level: advanced

676: .seealso: IPRegisterAll()
677: @*/
678: PetscErrorCode IPRegister(const char *name,PetscErrorCode (*function)(IP))
679: {

683:   PetscFunctionListAdd(&IPList,name,function);
684:   return(0);
685: }

687: PETSC_EXTERN PetscErrorCode IPCreate_Bilinear(IP);
688: #if defined(PETSC_USE_COMPLEX)
689: PETSC_EXTERN PetscErrorCode IPCreate_Sesquilin(IP);
690: #endif
691: PETSC_EXTERN PetscErrorCode IPCreate_Indefinite(IP);

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

698:    Not Collective

700:    Level: advanced
701: @*/
702: PetscErrorCode IPRegisterAll(void)
703: {

707:   IPRegisterAllCalled = PETSC_TRUE;
708:   IPRegister(IPBILINEAR,IPCreate_Bilinear);
709: #if defined(PETSC_USE_COMPLEX)
710:   IPRegister(IPSESQUILINEAR,IPCreate_Sesquilin);
711: #endif
712:   IPRegister(IPINDEFINITE,IPCreate_Indefinite);
713:   return(0);
714: }