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

Actual source code: dsbasic.c

      1: /*
      2:    Basic DS 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/dsimpl.h>      /*I "slepcds.h" I*/

     26: PetscFunctionList DSList = 0;
     27: PetscBool         DSRegisterAllCalled = PETSC_FALSE;
     28: PetscClassId      DS_CLASSID = 0;
     29: PetscLogEvent     DS_Solve = 0,DS_Function = 0,DS_Vectors = 0,DS_Other = 0;
     30: static PetscBool  DSPackageInitialized = PETSC_FALSE;
     31: const char        *DSMatName[DS_NUM_MAT] = {"A","B","C","T","D","F","Q","Z","X","Y","U","VT","W","E0","E1","E2","E3","E4","E5","E6","E7","E8","E9"};
     32: DSMatType         DSMatExtra[DS_NUM_EXTRA] = {DS_MAT_E0,DS_MAT_E1,DS_MAT_E2,DS_MAT_E3,DS_MAT_E4,DS_MAT_E5,DS_MAT_E6,DS_MAT_E7,DS_MAT_E8,DS_MAT_E9};

     36: /*@C
     37:    DSFinalizePackage - This function destroys everything in the SLEPc interface
     38:    to the DS package. It is called from SlepcFinalize().

     40:    Level: developer

     42: .seealso: SlepcFinalize()
     43: @*/
     44: PetscErrorCode DSFinalizePackage(void)
     45: {

     49:   PetscFunctionListDestroy(&DSList);
     50:   DSPackageInitialized = PETSC_FALSE;
     51:   DSRegisterAllCalled  = PETSC_FALSE;
     52:   return(0);
     53: }

     57: /*@C
     58:   DSInitializePackage - This function initializes everything in the DS package.
     59:   It is called from PetscDLLibraryRegister() when using dynamic libraries, and
     60:   on the first call to DSCreate() when using static libraries.

     62:   Level: developer

     64: .seealso: SlepcInitialize()
     65: @*/
     66: PetscErrorCode DSInitializePackage()
     67: {
     68:   char             logList[256];
     69:   char             *className;
     70:   PetscBool        opt;
     71:   PetscErrorCode   ierr;

     74:   if (DSPackageInitialized) return(0);
     75:   DSPackageInitialized = PETSC_TRUE;
     76:   /* Register Classes */
     77:   PetscClassIdRegister("Direct solver",&DS_CLASSID);
     78:   /* Register Constructors */
     79:   DSRegisterAll();
     80:   /* Register Events */
     81:   PetscLogEventRegister("DSSolve",DS_CLASSID,&DS_Solve);
     82:   PetscLogEventRegister("DSFunction",DS_CLASSID,&DS_Function);
     83:   PetscLogEventRegister("DSVectors",DS_CLASSID,&DS_Vectors);
     84:   PetscLogEventRegister("DSOther",DS_CLASSID,&DS_Other);
     85:   /* Process info exclusions */
     86:   PetscOptionsGetString(NULL,"-info_exclude",logList,256,&opt);
     87:   if (opt) {
     88:     PetscStrstr(logList,"ds",&className);
     89:     if (className) {
     90:       PetscInfoDeactivateClass(DS_CLASSID);
     91:     }
     92:   }
     93:   /* Process summary exclusions */
     94:   PetscOptionsGetString(NULL,"-log_summary_exclude",logList,256,&opt);
     95:   if (opt) {
     96:     PetscStrstr(logList,"ds",&className);
     97:     if (className) {
     98:       PetscLogEventDeactivateClass(DS_CLASSID);
     99:     }
    100:   }
    101:   PetscRegisterFinalize(DSFinalizePackage);
    102:   return(0);
    103: }

    107: /*@C
    108:    DSCreate - Creates a DS context.

    110:    Collective on MPI_Comm

    112:    Input Parameter:
    113: .  comm - MPI communicator

    115:    Output Parameter:
    116: .  newds - location to put the DS context

    118:    Level: beginner

    120:    Note:
    121:    DS objects are not intended for normal users but only for
    122:    advanced user that for instance implement their own solvers.

    124: .seealso: DSDestroy(), DS
    125: @*/
    126: PetscErrorCode DSCreate(MPI_Comm comm,DS *newds)
    127: {
    128:   DS             ds;
    129:   PetscInt       i;

    134:   *newds = 0;
    135: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
    136:   DSInitializePackage();
    137: #endif

    139:   SlepcHeaderCreate(ds,_p_DS,struct _DSOps,DS_CLASSID,"DS","Direct Solver (or Dense System)","DS",comm,DSDestroy,DSView);

    141:   ds->state         = DS_STATE_RAW;
    142:   ds->method        = 0;
    143:   ds->funmethod     = 0;
    144:   ds->compact       = PETSC_FALSE;
    145:   ds->refined       = PETSC_FALSE;
    146:   ds->extrarow      = PETSC_FALSE;
    147:   ds->ld            = 0;
    148:   ds->l             = 0;
    149:   ds->n             = 0;
    150:   ds->m             = 0;
    151:   ds->k             = 0;
    152:   ds->t             = 0;
    153:   for (i=0;i<DS_NUM_MAT;i++) {
    154:     ds->mat[i]      = NULL;
    155:     ds->rmat[i]     = NULL;
    156:   }
    157:   ds->nf            = 0;
    158:   for (i=0;i<DS_NUM_EXTRA;i++) ds->f[i] = NULL;
    159:   ds->perm          = NULL;
    160:   ds->work          = NULL;
    161:   ds->rwork         = NULL;
    162:   ds->iwork         = NULL;
    163:   ds->lwork         = 0;
    164:   ds->lrwork        = 0;
    165:   ds->liwork        = 0;
    166:   ds->comparison    = NULL;
    167:   ds->comparisonctx = NULL;

    169:   *newds = ds;
    170:   return(0);
    171: }

    175: /*@C
    176:    DSSetOptionsPrefix - Sets the prefix used for searching for all
    177:    DS options in the database.

    179:    Logically Collective on DS

    181:    Input Parameters:
    182: +  ds - the direct solver context
    183: -  prefix - the prefix string to prepend to all DS option requests

    185:    Notes:
    186:    A hyphen (-) must NOT be given at the beginning of the prefix name.
    187:    The first character of all runtime options is AUTOMATICALLY the
    188:    hyphen.

    190:    Level: advanced

    192: .seealso: DSAppendOptionsPrefix()
    193: @*/
    194: PetscErrorCode DSSetOptionsPrefix(DS ds,const char *prefix)
    195: {

    200:   PetscObjectSetOptionsPrefix((PetscObject)ds,prefix);
    201:   return(0);
    202: }

    206: /*@C
    207:    DSAppendOptionsPrefix - Appends to the prefix used for searching for all
    208:    DS options in the database.

    210:    Logically Collective on DS

    212:    Input Parameters:
    213: +  ds - the direct solver context
    214: -  prefix - the prefix string to prepend to all DS option requests

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

    220:    Level: advanced

    222: .seealso: DSSetOptionsPrefix()
    223: @*/
    224: PetscErrorCode DSAppendOptionsPrefix(DS ds,const char *prefix)
    225: {

    230:   PetscObjectAppendOptionsPrefix((PetscObject)ds,prefix);
    231:   return(0);
    232: }

    236: /*@C
    237:    DSGetOptionsPrefix - Gets the prefix used for searching for all
    238:    DS options in the database.

    240:    Not Collective

    242:    Input Parameters:
    243: .  ds - the direct solver context

    245:    Output Parameters:
    246: .  prefix - pointer to the prefix string used is returned

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

    251:    Level: advanced

    253: .seealso: DSSetOptionsPrefix(), DSAppendOptionsPrefix()
    254: @*/
    255: PetscErrorCode DSGetOptionsPrefix(DS ds,const char *prefix[])
    256: {

    262:   PetscObjectGetOptionsPrefix((PetscObject)ds,prefix);
    263:   return(0);
    264: }

    268: /*@C
    269:    DSSetType - Selects the type for the DS object.

    271:    Logically Collective on DS

    273:    Input Parameter:
    274: +  ds   - the direct solver context
    275: -  type - a known type

    277:    Level: intermediate

    279: .seealso: DSGetType()
    280: @*/
    281: PetscErrorCode DSSetType(DS ds,DSType type)
    282: {
    283:   PetscErrorCode ierr,(*r)(DS);
    284:   PetscBool      match;

    290:   PetscObjectTypeCompare((PetscObject)ds,type,&match);
    291:   if (match) return(0);

    293:    PetscFunctionListFind(DSList,type,&r);
    294:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested DS type %s",type);

    296:   PetscMemzero(ds->ops,sizeof(struct _DSOps));

    298:   PetscObjectChangeTypeName((PetscObject)ds,type);
    299:   (*r)(ds);
    300:   return(0);
    301: }

    305: /*@C
    306:    DSGetType - Gets the DS type name (as a string) from the DS context.

    308:    Not Collective

    310:    Input Parameter:
    311: .  ds - the direct solver context

    313:    Output Parameter:
    314: .  name - name of the direct solver

    316:    Level: intermediate

    318: .seealso: DSSetType()
    319: @*/
    320: PetscErrorCode DSGetType(DS ds,DSType *type)
    321: {
    325:   *type = ((PetscObject)ds)->type_name;
    326:   return(0);
    327: }

    331: /*@
    332:    DSSetMethod - Selects the method to be used to solve the problem.

    334:    Logically Collective on DS

    336:    Input Parameter:
    337: +  ds   - the direct solver context
    338: -  meth - an index indentifying the method

    340:    Level: intermediate

    342: .seealso: DSGetMethod()
    343: @*/
    344: PetscErrorCode DSSetMethod(DS ds,PetscInt meth)
    345: {
    349:   if (meth<0) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
    350:   if (meth>DS_MAX_SOLVE) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
    351:   ds->method = meth;
    352:   return(0);
    353: }

    357: /*@
    358:    DSGetMethod - Gets the method currently used in the DS.

    360:    Not Collective

    362:    Input Parameter:
    363: .  ds - the direct solver context

    365:    Output Parameter:
    366: .  meth - identifier of the method

    368:    Level: intermediate

    370: .seealso: DSSetMethod()
    371: @*/
    372: PetscErrorCode DSGetMethod(DS ds,PetscInt *meth)
    373: {
    377:   *meth = ds->method;
    378:   return(0);
    379: }

    383: /*@
    384:    DSSetFunctionMethod - Selects the method to be used to compute a matrix function.

    386:    Logically Collective on DS

    388:    Input Parameter:
    389: +  ds   - the direct solver context
    390: -  meth - an index indentifying the function method

    392:    Level: intermediate

    394: .seealso: DSGetFunctionMethod()
    395: @*/
    396: PetscErrorCode DSSetFunctionMethod(DS ds,PetscInt meth)
    397: {
    401:   if (meth<0) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
    402:   if (meth>DS_MAX_FUN) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
    403:   ds->funmethod = meth;
    404:   return(0);
    405: }

    409: /*@
    410:    DSGetFunctionMethod - Gets the method currently used to compute a matrix function.

    412:    Not Collective

    414:    Input Parameter:
    415: .  ds - the direct solver context

    417:    Output Parameter:
    418: .  meth - identifier of the function method

    420:    Level: intermediate

    422: .seealso: DSSetFunctionMethod()
    423: @*/
    424: PetscErrorCode DSGetFunctionMethod(DS ds,PetscInt *meth)
    425: {
    429:   *meth = ds->funmethod;
    430:   return(0);
    431: }

    435: /*@
    436:    DSSetCompact - Switch to compact storage of matrices.

    438:    Logically Collective on DS

    440:    Input Parameter:
    441: +  ds   - the direct solver context
    442: -  comp - a boolean flag

    444:    Notes:
    445:    Compact storage is used in some DS types such as DSHEP when the matrix
    446:    is tridiagonal. This flag can be used to indicate whether the user
    447:    provides the matrix entries via the compact form (the tridiagonal DS_MAT_T)
    448:    or the non-compact one (DS_MAT_A).

    450:    The default is PETSC_FALSE.

    452:    Level: advanced

    454: .seealso: DSGetCompact()
    455: @*/
    456: PetscErrorCode DSSetCompact(DS ds,PetscBool comp)
    457: {
    461:   ds->compact = comp;
    462:   return(0);
    463: }

    467: /*@
    468:    DSGetCompact - Gets the compact storage flag.

    470:    Not Collective

    472:    Input Parameter:
    473: .  ds - the direct solver context

    475:    Output Parameter:
    476: .  comp - the flag

    478:    Level: advanced

    480: .seealso: DSSetCompact()
    481: @*/
    482: PetscErrorCode DSGetCompact(DS ds,PetscBool *comp)
    483: {
    487:   *comp = ds->compact;
    488:   return(0);
    489: }

    493: /*@
    494:    DSSetExtraRow - Sets a flag to indicate that the matrix has one extra
    495:    row.

    497:    Logically Collective on DS

    499:    Input Parameter:
    500: +  ds  - the direct solver context
    501: -  ext - a boolean flag

    503:    Notes:
    504:    In Krylov methods it is useful that the matrix representing the direct solver
    505:    has one extra row, i.e., has dimension (n+1) x n. If this flag is activated, all
    506:    transformations applied to the right of the matrix also affect this additional
    507:    row. In that case, (n+1) must be less or equal than the leading dimension.

    509:    The default is PETSC_FALSE.

    511:    Level: advanced

    513: .seealso: DSSolve(), DSAllocate(), DSGetExtraRow()
    514: @*/
    515: PetscErrorCode DSSetExtraRow(DS ds,PetscBool ext)
    516: {
    520:   if (ds->n>0 && ds->n==ds->ld) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Cannot set extra row after setting n=ld");
    521:   ds->extrarow = ext;
    522:   return(0);
    523: }

    527: /*@
    528:    DSGetExtraRow - Gets the extra row flag.

    530:    Not Collective

    532:    Input Parameter:
    533: .  ds - the direct solver context

    535:    Output Parameter:
    536: .  ext - the flag

    538:    Level: advanced

    540: .seealso: DSSetExtraRow()
    541: @*/
    542: PetscErrorCode DSGetExtraRow(DS ds,PetscBool *ext)
    543: {
    547:   *ext = ds->extrarow;
    548:   return(0);
    549: }

    553: /*@
    554:    DSSetRefined - Sets a flag to indicate that refined vectors must be
    555:    computed.

    557:    Logically Collective on DS

    559:    Input Parameter:
    560: +  ds  - the direct solver context
    561: -  ref - a boolean flag

    563:    Notes:
    564:    Normally the vectors returned in DS_MAT_X are eigenvectors of the
    565:    projected matrix. With this flag activated, DSVectors() will return
    566:    the right singular vector of the smallest singular value of matrix
    567:    \tilde{A}-theta*I, where \tilde{A} is the extended (n+1)xn matrix
    568:    and theta is the Ritz value. This is used in the refined Ritz
    569:    approximation.

    571:    The default is PETSC_FALSE.

    573:    Level: advanced

    575: .seealso: DSVectors(), DSGetRefined()
    576: @*/
    577: PetscErrorCode DSSetRefined(DS ds,PetscBool ref)
    578: {
    582:   ds->refined = ref;
    583:   return(0);
    584: }

    588: /*@
    589:    DSGetRefined - Gets the refined vectors flag.

    591:    Not Collective

    593:    Input Parameter:
    594: .  ds - the direct solver context

    596:    Output Parameter:
    597: .  ref - the flag

    599:    Level: advanced

    601: .seealso: DSSetRefined()
    602: @*/
    603: PetscErrorCode DSGetRefined(DS ds,PetscBool *ref)
    604: {
    608:   *ref = ds->refined;
    609:   return(0);
    610: }

    614: /*@C
    615:    DSSetEigenvalueComparison - Specifies the eigenvalue comparison function
    616:    to be used for sorting.

    618:    Logically Collective on DS

    620:    Input Parameters:
    621: +  ds  - the direct solver context
    622: .  fun - a pointer to the comparison function
    623: -  ctx - a context pointer (the last parameter to the comparison function)

    625:    Calling Sequence of fun:
    626: $  func(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *res,void *ctx)

    628: +   ar     - real part of the 1st eigenvalue
    629: .   ai     - imaginary part of the 1st eigenvalue
    630: .   br     - real part of the 2nd eigenvalue
    631: .   bi     - imaginary part of the 2nd eigenvalue
    632: .   res    - result of comparison
    633: -   ctx    - optional context, as set by DSSetEigenvalueComparison()

    635:    Note:
    636:    The returning parameter 'res' can be
    637: +  negative - if the 1st eigenvalue is preferred to the 2st one
    638: .  zero     - if both eigenvalues are equally preferred
    639: -  positive - if the 2st eigenvalue is preferred to the 1st one

    641:    Level: developer

    643: .seealso: DSSort()
    644: @*/
    645: PetscErrorCode DSSetEigenvalueComparison(DS ds,PetscErrorCode (*fun)(PetscScalar,PetscScalar,PetscScalar,PetscScalar,PetscInt*,void*),void* ctx)
    646: {
    649:   ds->comparison    = fun;
    650:   ds->comparisonctx = ctx;
    651:   return(0);
    652: }

    656: /*@C
    657:    DSGetEigenvalueComparison - Gets the eigenvalue comparison function
    658:    used for sorting.

    660:    Not Collective

    662:    Input Parameter:
    663: .  ds  - the direct solver context

    665:    Output Parameters:
    666: +  fun - a pointer to the comparison function
    667: -  ctx - a context pointer (the last parameter to the comparison function)

    669:    Calling Sequence of fun:
    670: $  func(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *res,void *ctx)

    672: +   ar     - real part of the 1st eigenvalue
    673: .   ai     - imaginary part of the 1st eigenvalue
    674: .   br     - real part of the 2nd eigenvalue
    675: .   bi     - imaginary part of the 2nd eigenvalue
    676: .   res    - result of comparison
    677: -   ctx    - optional context, as set by DSSetEigenvalueComparison()

    679:    Note:
    680:    The returning parameter 'res' can be
    681: +  negative - if the 1st eigenvalue is preferred to the 2st one
    682: .  zero     - if both eigenvalues are equally preferred
    683: -  positive - if the 2st eigenvalue is preferred to the 1st one

    685:    Level: developer

    687: .seealso: DSSort(), DSSetEigenvalueComparison()
    688: @*/
    689: PetscErrorCode DSGetEigenvalueComparison(DS ds,PetscErrorCode (**fun)(PetscScalar,PetscScalar,PetscScalar,PetscScalar,PetscInt*,void*),void** ctx)
    690: {
    693:   if (fun) *fun = ds->comparison;
    694:   if (ctx) *ctx = ds->comparisonctx;
    695:   return(0);
    696: }

    700: /*@
    701:    DSSetFN - Sets a number of functions to be used internally by DS.

    703:    Collective on DS and FN

    705:    Input Parameters:
    706: +  ds - the direct solver context
    707: .  n  - number of functions
    708: -  f  - array of functions

    710:    Notes:
    711:    In the basic usage, only one function is used, for instance to
    712:    evaluate a function of the projected matrix. In the context of nonlinear
    713:    eigensolvers, there are as many functions as terms in the split
    714:    nonlinear operator T(lambda) = sum_i A_i*f_i(lambda).

    716:    This function must be called before DSAllocate(). Then DSAllocate()
    717:    will allocate an extra matrix per each function.

    719:    Level: developer

    721: .seealso: DSGetFN(), DSGetFN(), DSAllocate()
    722:  @*/
    723: PetscErrorCode DSSetFN(DS ds,PetscInt n,FN f[])
    724: {
    725:   PetscInt       i;

    731:   if (n<=0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Must have one or more functions, you have %D",n);
    732:   if (n>DS_NUM_EXTRA) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Too many functions, you specified %D but the limit is",n,DS_NUM_EXTRA);
    733:   if (ds->ld) { PetscInfo(ds,"DSSetFN() called after DSAllocate()\n"); }
    736:   for (i=0;i<ds->nf;i++) {
    737:     FNDestroy(&ds->f[i]);
    738:   }
    739:   for (i=0;i<n;i++) {
    741:     PetscObjectReference((PetscObject)f[i]);
    742:     ds->f[i] = f[i];
    743:   }
    744:   ds->nf = n;
    745:   return(0);
    746: }

    750: /*@
    751:    DSGetFN - Gets the functions associated with this DS.

    753:    Not collective, though parallel FNs are returned if the DS is parallel

    755:    Input Parameter:
    756: +  ds - the direct olver context
    757: -  k  - the index of the requested function (starting in 0)

    759:    Output Parameter:
    760: .  f - the function

    762:    Level: developer

    764: .seealso: DSSetFN()
    765: @*/
    766: PetscErrorCode DSGetFN(DS ds,PetscInt k,FN *f)
    767: {
    770:   if (k<0 || k>=ds->nf) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"k must be between 0 and %d",ds->nf-1);
    772:   *f = ds->f[k];
    773:   return(0);
    774: }

    778: /*@
    779:    DSGetNumFN - Returns the number of functions stored internally by
    780:    the DS.

    782:    Not collective

    784:    Input Parameter:
    785: .  ds - the direct solver context

    787:    Output Parameters:
    788: .  n - the number of functions passed in DSSetFN()

    790:    Level: developer

    792: .seealso: DSSetFN()
    793: @*/
    794: PetscErrorCode DSGetNumFN(DS ds,PetscInt *n)
    795: {
    799:   *n = ds->nf;
    800:   return(0);
    801: }

    805: /*@
    806:    DSSetFromOptions - Sets DS options from the options database.

    808:    Collective on DS

    810:    Input Parameters:
    811: .  ds - the direct solver context

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

    816:    Level: beginner
    817: @*/
    818: PetscErrorCode DSSetFromOptions(DS ds)
    819: {
    821:   PetscInt       meth;
    822:   PetscBool      flag;

    826:   if (!DSRegisterAllCalled) { DSRegisterAll(); }
    827:   /* Set default type (we do not allow changing it with -ds_type) */
    828:   if (!((PetscObject)ds)->type_name) {
    829:     DSSetType(ds,DSNHEP);
    830:   }
    831:   PetscObjectOptionsBegin((PetscObject)ds);
    832:     PetscOptionsInt("-ds_method","Method to be used for the dense system","DSSetMethod",ds->method,&meth,&flag);
    833:     if (flag) { DSSetMethod(ds,meth); }
    834:     PetscOptionsInt("-ds_function_method","Method to be used to compute a matrix function","DSSetFunctionMethod",ds->funmethod,&meth,&flag);
    835:     if (flag) { DSSetFunctionMethod(ds,meth); }
    836:     PetscObjectProcessOptionsHandlers((PetscObject)ds);
    837:   PetscOptionsEnd();
    838:   return(0);
    839: }

    843: /*@C
    844:    DSView - Prints the DS data structure.

    846:    Collective on DS

    848:    Input Parameters:
    849: +  ds - the direct solver context
    850: -  viewer - optional visualization context

    852:    Note:
    853:    The available visualization contexts include
    854: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
    855: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
    856:          output where only the first processor opens
    857:          the file.  All other processors send their
    858:          data to the first processor to print.

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

    863:    Level: beginner

    865: .seealso: PetscViewerASCIIOpen()
    866: @*/
    867: PetscErrorCode DSView(DS ds,PetscViewer viewer)
    868: {
    869:   PetscBool         isascii,issvd;
    870:   const char        *state;
    871:   PetscViewerFormat format;
    872:   PetscErrorCode    ierr;

    876:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)ds));
    879:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    880:   if (isascii) {
    881:     PetscViewerGetFormat(viewer,&format);
    882:     PetscObjectPrintClassNamePrefixType((PetscObject)ds,viewer,"DS Object");
    883:     if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
    884:       switch (ds->state) {
    885:         case DS_STATE_RAW:          state = "raw"; break;
    886:         case DS_STATE_INTERMEDIATE: state = "intermediate"; break;
    887:         case DS_STATE_CONDENSED:    state = "condensed"; break;
    888:         case DS_STATE_TRUNCATED:    state = "truncated"; break;
    889:         default: SETERRQ(PetscObjectComm((PetscObject)ds),1,"Wrong value of ds->state");
    890:       }
    891:       PetscViewerASCIIPrintf(viewer,"  current state: %s\n",state);
    892:       PetscObjectTypeCompare((PetscObject)ds,DSSVD,&issvd);
    893:       if (issvd) {
    894:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%d, n=%d, m=%d, l=%d, k=%d",ds->ld,ds->n,ds->m,ds->l,ds->k);
    895:       } else {
    896:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%d, n=%d, l=%d, k=%d",ds->ld,ds->n,ds->l,ds->k);
    897:       }
    898:       if (ds->state==DS_STATE_TRUNCATED) {
    899:         PetscViewerASCIIPrintf(viewer,", t=%d\n",ds->t);
    900:       } else {
    901:         PetscViewerASCIIPrintf(viewer,"\n");
    902:       }
    903:       PetscViewerASCIIPrintf(viewer,"  flags:%s%s%s\n",ds->compact?" compact":"",ds->extrarow?" extrarow":"",ds->refined?" refined":"");
    904:       if (ds->nf) {
    905:         PetscViewerASCIIPrintf(viewer,"  number of functions: %d\n",ds->nf);
    906:       }
    907:     }
    908:     if (ds->ops->view) {
    909:       PetscViewerASCIIPushTab(viewer);
    910:       (*ds->ops->view)(ds,viewer);
    911:       PetscViewerASCIIPopTab(viewer);
    912:     }
    913:   }
    914:   return(0);
    915: }

    919: /*@
    920:    DSAllocate - Allocates memory for internal storage or matrices in DS.

    922:    Logically Collective on DS

    924:    Input Parameters:
    925: +  ds - the direct solver context
    926: -  ld - leading dimension (maximum allowed dimension for the matrices, including
    927:         the extra row if present)

    929:    Level: intermediate

    931: .seealso: DSGetLeadingDimension(), DSSetDimensions(), DSSetExtraRow()
    932: @*/
    933: PetscErrorCode DSAllocate(DS ds,PetscInt ld)
    934: {
    936:   PetscInt       i;

    941:   if (ld<1) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Leading dimension should be at least one");
    942:   ds->ld = ld;
    943:   (*ds->ops->allocate)(ds,ld);
    944:   for (i=0;i<ds->nf;i++) {
    945:     DSAllocateMat_Private(ds,DSMatExtra[i]);
    946:   }
    947:   return(0);
    948: }

    952: /*@
    953:    DSReset - Resets the DS context to the initial state.

    955:    Collective on DS

    957:    Input Parameter:
    958: .  ds - the direct solver context

    960:    Level: advanced

    962: .seealso: DSDestroy()
    963: @*/
    964: PetscErrorCode DSReset(DS ds)
    965: {
    966:   PetscInt       i;

    971:   ds->state    = DS_STATE_RAW;
    972:   ds->compact  = PETSC_FALSE;
    973:   ds->refined  = PETSC_FALSE;
    974:   ds->extrarow = PETSC_FALSE;
    975:   ds->ld       = 0;
    976:   ds->l        = 0;
    977:   ds->n        = 0;
    978:   ds->m        = 0;
    979:   ds->k        = 0;
    980:   for (i=0;i<DS_NUM_MAT;i++) {
    981:     PetscFree(ds->mat[i]);
    982:     PetscFree(ds->rmat[i]);
    983:   }
    984:   for (i=0;i<ds->nf;i++) {
    985:     FNDestroy(&ds->f[i]);
    986:   }
    987:   ds->nf            = 0;
    988:   PetscFree(ds->perm);
    989:   PetscFree(ds->work);
    990:   PetscFree(ds->rwork);
    991:   PetscFree(ds->iwork);
    992:   ds->lwork         = 0;
    993:   ds->lrwork        = 0;
    994:   ds->liwork        = 0;
    995:   ds->comparison    = NULL;
    996:   ds->comparisonctx = NULL;
    997:   return(0);
    998: }

    1002: /*@C
    1003:    DSDestroy - Destroys DS context that was created with DSCreate().

    1005:    Collective on DS

    1007:    Input Parameter:
    1008: .  ds - the direct solver context

    1010:    Level: beginner

    1012: .seealso: DSCreate()
    1013: @*/
    1014: PetscErrorCode DSDestroy(DS *ds)
    1015: {

    1019:   if (!*ds) return(0);
    1021:   if (--((PetscObject)(*ds))->refct > 0) { *ds = 0; return(0); }
    1022:   DSReset(*ds);
    1023:   PetscHeaderDestroy(ds);
    1024:   return(0);
    1025: }

    1029: /*@C
    1030:    DSRegister - Adds a direct solver to the DS package.

    1032:    Not collective

    1034:    Input Parameters:
    1035: +  name - name of a new user-defined DS
    1036: -  routine_create - routine to create context

    1038:    Notes:
    1039:    DSRegister() may be called multiple times to add several user-defined
    1040:    direct solvers.

    1042:    Level: advanced

    1044: .seealso: DSRegisterAll()
    1045: @*/
    1046: PetscErrorCode DSRegister(const char *name,PetscErrorCode (*function)(DS))
    1047: {

    1051:   PetscFunctionListAdd(&DSList,name,function);
    1052:   return(0);
    1053: }

    1055: PETSC_EXTERN PetscErrorCode DSCreate_HEP(DS);
    1056: PETSC_EXTERN PetscErrorCode DSCreate_NHEP(DS);
    1057: PETSC_EXTERN PetscErrorCode DSCreate_GHEP(DS);
    1058: PETSC_EXTERN PetscErrorCode DSCreate_GHIEP(DS);
    1059: PETSC_EXTERN PetscErrorCode DSCreate_GNHEP(DS);
    1060: PETSC_EXTERN PetscErrorCode DSCreate_SVD(DS);
    1061: PETSC_EXTERN PetscErrorCode DSCreate_NEP(DS);

    1065: /*@C
    1066:    DSRegisterAll - Registers all of the direct solvers in the DS package.

    1068:    Not Collective

    1070:    Level: advanced
    1071: @*/
    1072: PetscErrorCode DSRegisterAll(void)
    1073: {

    1077:   DSRegisterAllCalled = PETSC_TRUE;
    1078:   DSRegister(DSHEP,DSCreate_HEP);
    1079:   DSRegister(DSNHEP,DSCreate_NHEP);
    1080:   DSRegister(DSGHEP,DSCreate_GHEP);
    1081:   DSRegister(DSGHIEP,DSCreate_GHIEP);
    1082:   DSRegister(DSGNHEP,DSCreate_GNHEP);
    1083:   DSRegister(DSSVD,DSCreate_SVD);
    1084:   DSRegister(DSNEP,DSCreate_NEP);
    1085:   return(0);
    1086: }