Date: 2013-09-02T10:08:28+00:00

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