Date: 2016-03-29T14:56:41+00:00

Actual source code: dsbasic.c
slepc-3.6.3 2016-03-29
Report Typos and Errors

      1: /*
      2:    Basic DS routines

      4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      6:    Copyright (c) 2002-2015, 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_Vectors = 0,DS_Other = 0;
     30: static PetscBool  DSPackageInitialized = PETSC_FALSE;
     31: const char        *DSMatName[DS_NUM_MAT] = {"A","B","C","T","D","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("DSVectors",DS_CLASSID,&DS_Vectors);
     83:   PetscLogEventRegister("DSOther",DS_CLASSID,&DS_Other);
     84:   /* Process info exclusions */
     85:   PetscOptionsGetString(NULL,"-info_exclude",logList,256,&opt);
     86:   if (opt) {
     87:     PetscStrstr(logList,"ds",&className);
     88:     if (className) {
     89:       PetscInfoDeactivateClass(DS_CLASSID);
     90:     }
     91:   }
     92:   /* Process summary exclusions */
     93:   PetscOptionsGetString(NULL,"-log_summary_exclude",logList,256,&opt);
     94:   if (opt) {
     95:     PetscStrstr(logList,"ds",&className);
     96:     if (className) {
     97:       PetscLogEventDeactivateClass(DS_CLASSID);
     98:     }
     99:   }
    100:   PetscRegisterFinalize(DSFinalizePackage);
    101:   return(0);
    102: }

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

    109:    Collective on MPI_Comm

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

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

    117:    Level: beginner

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

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

    133:   *newds = 0;
    134:   DSInitializePackage();
    135:   SlepcHeaderCreate(ds,DS_CLASSID,"DS","Direct Solver (or Dense System)","DS",comm,DSDestroy,DSView);

    137:   ds->state         = DS_STATE_RAW;
    138:   ds->method        = 0;
    139:   ds->compact       = PETSC_FALSE;
    140:   ds->refined       = PETSC_FALSE;
    141:   ds->extrarow      = PETSC_FALSE;
    142:   ds->ld            = 0;
    143:   ds->l             = 0;
    144:   ds->n             = 0;
    145:   ds->m             = 0;
    146:   ds->k             = 0;
    147:   ds->t             = 0;
    148:   ds->bs            = 1;
    149:   ds->sc            = NULL;

    151:   for (i=0;i<DS_NUM_MAT;i++) {
    152:     ds->mat[i]      = NULL;
    153:     ds->rmat[i]     = NULL;
    154:     ds->omat[i]     = NULL;
    155:   }
    156:   ds->perm          = NULL;
    157:   ds->data          = NULL;
    158:   ds->work          = NULL;
    159:   ds->rwork         = NULL;
    160:   ds->iwork         = NULL;
    161:   ds->lwork         = 0;
    162:   ds->lrwork        = 0;
    163:   ds->liwork        = 0;

    165:   *newds = ds;
    166:   return(0);
    167: }

    171: /*@C
    172:    DSSetOptionsPrefix - Sets the prefix used for searching for all
    173:    DS options in the database.

    175:    Logically Collective on DS

    177:    Input Parameters:
    178: +  ds - the direct solver context
    179: -  prefix - the prefix string to prepend to all DS option requests

    181:    Notes:
    182:    A hyphen (-) must NOT be given at the beginning of the prefix name.
    183:    The first character of all runtime options is AUTOMATICALLY the
    184:    hyphen.

    186:    Level: advanced

    188: .seealso: DSAppendOptionsPrefix()
    189: @*/
    190: PetscErrorCode DSSetOptionsPrefix(DS ds,const char *prefix)
    191: {

    196:   PetscObjectSetOptionsPrefix((PetscObject)ds,prefix);
    197:   return(0);
    198: }

    202: /*@C
    203:    DSAppendOptionsPrefix - Appends to the prefix used for searching for all
    204:    DS options in the database.

    206:    Logically Collective on DS

    208:    Input Parameters:
    209: +  ds - the direct solver context
    210: -  prefix - the prefix string to prepend to all DS option requests

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

    216:    Level: advanced

    218: .seealso: DSSetOptionsPrefix()
    219: @*/
    220: PetscErrorCode DSAppendOptionsPrefix(DS ds,const char *prefix)
    221: {

    226:   PetscObjectAppendOptionsPrefix((PetscObject)ds,prefix);
    227:   return(0);
    228: }

    232: /*@C
    233:    DSGetOptionsPrefix - Gets the prefix used for searching for all
    234:    DS options in the database.

    236:    Not Collective

    238:    Input Parameters:
    239: .  ds - the direct solver context

    241:    Output Parameters:
    242: .  prefix - pointer to the prefix string used is returned

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

    247:    Level: advanced

    249: .seealso: DSSetOptionsPrefix(), DSAppendOptionsPrefix()
    250: @*/
    251: PetscErrorCode DSGetOptionsPrefix(DS ds,const char *prefix[])
    252: {

    258:   PetscObjectGetOptionsPrefix((PetscObject)ds,prefix);
    259:   return(0);
    260: }

    264: /*@C
    265:    DSSetType - Selects the type for the DS object.

    267:    Logically Collective on DS

    269:    Input Parameter:
    270: +  ds   - the direct solver context
    271: -  type - a known type

    273:    Level: intermediate

    275: .seealso: DSGetType()
    276: @*/
    277: PetscErrorCode DSSetType(DS ds,DSType type)
    278: {
    279:   PetscErrorCode ierr,(*r)(DS);
    280:   PetscBool      match;

    286:   PetscObjectTypeCompare((PetscObject)ds,type,&match);
    287:   if (match) return(0);

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

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

    294:   PetscObjectChangeTypeName((PetscObject)ds,type);
    295:   (*r)(ds);
    296:   return(0);
    297: }

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

    304:    Not Collective

    306:    Input Parameter:
    307: .  ds - the direct solver context

    309:    Output Parameter:
    310: .  name - name of the direct solver

    312:    Level: intermediate

    314: .seealso: DSSetType()
    315: @*/
    316: PetscErrorCode DSGetType(DS ds,DSType *type)
    317: {
    321:   *type = ((PetscObject)ds)->type_name;
    322:   return(0);
    323: }

    327: /*@
    328:    DSSetMethod - Selects the method to be used to solve the problem.

    330:    Logically Collective on DS

    332:    Input Parameter:
    333: +  ds   - the direct solver context
    334: -  meth - an index indentifying the method

    336:    Level: intermediate

    338: .seealso: DSGetMethod()
    339: @*/
    340: PetscErrorCode DSSetMethod(DS ds,PetscInt meth)
    341: {
    345:   if (meth<0) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
    346:   if (meth>DS_MAX_SOLVE) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
    347:   ds->method = meth;
    348:   return(0);
    349: }

    353: /*@
    354:    DSGetMethod - Gets the method currently used in the DS.

    356:    Not Collective

    358:    Input Parameter:
    359: .  ds - the direct solver context

    361:    Output Parameter:
    362: .  meth - identifier of the method

    364:    Level: intermediate

    366: .seealso: DSSetMethod()
    367: @*/
    368: PetscErrorCode DSGetMethod(DS ds,PetscInt *meth)
    369: {
    373:   *meth = ds->method;
    374:   return(0);
    375: }

    379: /*@
    380:    DSSetCompact - Switch to compact storage of matrices.

    382:    Logically Collective on DS

    384:    Input Parameter:
    385: +  ds   - the direct solver context
    386: -  comp - a boolean flag

    388:    Notes:
    389:    Compact storage is used in some DS types such as DSHEP when the matrix
    390:    is tridiagonal. This flag can be used to indicate whether the user
    391:    provides the matrix entries via the compact form (the tridiagonal DS_MAT_T)
    392:    or the non-compact one (DS_MAT_A).

    394:    The default is PETSC_FALSE.

    396:    Level: advanced

    398: .seealso: DSGetCompact()
    399: @*/
    400: PetscErrorCode DSSetCompact(DS ds,PetscBool comp)
    401: {
    405:   ds->compact = comp;
    406:   return(0);
    407: }

    411: /*@
    412:    DSGetCompact - Gets the compact storage flag.

    414:    Not Collective

    416:    Input Parameter:
    417: .  ds - the direct solver context

    419:    Output Parameter:
    420: .  comp - the flag

    422:    Level: advanced

    424: .seealso: DSSetCompact()
    425: @*/
    426: PetscErrorCode DSGetCompact(DS ds,PetscBool *comp)
    427: {
    431:   *comp = ds->compact;
    432:   return(0);
    433: }

    437: /*@
    438:    DSSetExtraRow - Sets a flag to indicate that the matrix has one extra
    439:    row.

    441:    Logically Collective on DS

    443:    Input Parameter:
    444: +  ds  - the direct solver context
    445: -  ext - a boolean flag

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

    453:    The default is PETSC_FALSE.

    455:    Level: advanced

    457: .seealso: DSSolve(), DSAllocate(), DSGetExtraRow()
    458: @*/
    459: PetscErrorCode DSSetExtraRow(DS ds,PetscBool ext)
    460: {
    464:   if (ds->n>0 && ds->n==ds->ld) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Cannot set extra row after setting n=ld");
    465:   ds->extrarow = ext;
    466:   return(0);
    467: }

    471: /*@
    472:    DSGetExtraRow - Gets the extra row flag.

    474:    Not Collective

    476:    Input Parameter:
    477: .  ds - the direct solver context

    479:    Output Parameter:
    480: .  ext - the flag

    482:    Level: advanced

    484: .seealso: DSSetExtraRow()
    485: @*/
    486: PetscErrorCode DSGetExtraRow(DS ds,PetscBool *ext)
    487: {
    491:   *ext = ds->extrarow;
    492:   return(0);
    493: }

    497: /*@
    498:    DSSetRefined - Sets a flag to indicate that refined vectors must be
    499:    computed.

    501:    Logically Collective on DS

    503:    Input Parameter:
    504: +  ds  - the direct solver context
    505: -  ref - a boolean flag

    507:    Notes:
    508:    Normally the vectors returned in DS_MAT_X are eigenvectors of the
    509:    projected matrix. With this flag activated, DSVectors() will return
    510:    the right singular vector of the smallest singular value of matrix
    511:    \tilde{A}-theta*I, where \tilde{A} is the extended (n+1)xn matrix
    512:    and theta is the Ritz value. This is used in the refined Ritz
    513:    approximation.

    515:    The default is PETSC_FALSE.

    517:    Level: advanced

    519: .seealso: DSVectors(), DSGetRefined()
    520: @*/
    521: PetscErrorCode DSSetRefined(DS ds,PetscBool ref)
    522: {
    526:   ds->refined = ref;
    527:   return(0);
    528: }

    532: /*@
    533:    DSGetRefined - Gets the refined vectors flag.

    535:    Not Collective

    537:    Input Parameter:
    538: .  ds - the direct solver context

    540:    Output Parameter:
    541: .  ref - the flag

    543:    Level: advanced

    545: .seealso: DSSetRefined()
    546: @*/
    547: PetscErrorCode DSGetRefined(DS ds,PetscBool *ref)
    548: {
    552:   *ref = ds->refined;
    553:   return(0);
    554: }

    558: /*@
    559:    DSSetBlockSize - Sets the block size.

    561:    Logically Collective on DS

    563:    Input Parameter:
    564: +  ds - the direct solver context
    565: -  bs - the block size

    567:    Level: intermediate

    569: .seealso: DSGetBlockSize()
    570: @*/
    571: PetscErrorCode DSSetBlockSize(DS ds,PetscInt bs)
    572: {
    576:   if (bs<1) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The block size must be at least one");
    577:   ds->bs = bs;
    578:   return(0);
    579: }

    583: /*@
    584:    DSGetBlockSize - Gets the block size.

    586:    Not Collective

    588:    Input Parameter:
    589: .  ds - the direct solver context

    591:    Output Parameter:
    592: .  bs - block size

    594:    Level: intermediate

    596: .seealso: DSSetBlockSize()
    597: @*/
    598: PetscErrorCode DSGetBlockSize(DS ds,PetscInt *bs)
    599: {
    603:   *bs = ds->bs;
    604:   return(0);
    605: }

    609: /*@C
    610:    DSSetSlepcSC - Sets the sorting criterion context.

    612:    Not Collective

    614:    Input Parameters:
    615: +  ds - the direct solver context
    616: -  sc - a pointer to the sorting criterion context

    618:    Level: developer

    620: .seealso: DSGetSlepcSC(), DSSort()
    621: @*/
    622: PetscErrorCode DSSetSlepcSC(DS ds,SlepcSC sc)
    623: {

    629:   if (ds->sc) {
    630:     PetscFree(ds->sc);
    631:   }
    632:   ds->sc = sc;
    633:   return(0);
    634: }

    638: /*@C
    639:    DSGetSlepcSC - Gets the sorting criterion context.

    641:    Not Collective

    643:    Input Parameter:
    644: .  ds - the direct solver context

    646:    Output Parameters:
    647: .  sc - a pointer to the sorting criterion context

    649:    Level: developer

    651: .seealso: DSSetSlepcSC(), DSSort()
    652: @*/
    653: PetscErrorCode DSGetSlepcSC(DS ds,SlepcSC *sc)
    654: {

    660:   if (!ds->sc) {
    661:     PetscNewLog(ds,&ds->sc);
    662:   }
    663:   *sc = ds->sc;
    664:   return(0);
    665: }

    669: /*@
    670:    DSSetFromOptions - Sets DS options from the options database.

    672:    Collective on DS

    674:    Input Parameters:
    675: .  ds - the direct solver context

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

    680:    Level: beginner
    681: @*/
    682: PetscErrorCode DSSetFromOptions(DS ds)
    683: {
    685:   PetscInt       bs,meth;
    686:   PetscBool      flag;

    690:   DSRegisterAll();
    691:   /* Set default type (we do not allow changing it with -ds_type) */
    692:   if (!((PetscObject)ds)->type_name) {
    693:     DSSetType(ds,DSNHEP);
    694:   }
    695:   PetscObjectOptionsBegin((PetscObject)ds);
    696:     PetscOptionsInt("-ds_block_size","Block size for the dense system solver","DSSetBlockSize",ds->bs,&bs,&flag);
    697:     if (flag) { DSSetBlockSize(ds,bs); }
    698:     PetscOptionsInt("-ds_method","Method to be used for the dense system","DSSetMethod",ds->method,&meth,&flag);
    699:     if (flag) { DSSetMethod(ds,meth); }
    700:     PetscObjectProcessOptionsHandlers((PetscObject)ds);
    701:   PetscOptionsEnd();
    702:   return(0);
    703: }

    707: /*@C
    708:    DSView - Prints the DS data structure.

    710:    Collective on DS

    712:    Input Parameters:
    713: +  ds - the direct solver context
    714: -  viewer - optional visualization context

    716:    Note:
    717:    The available visualization contexts include
    718: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
    719: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
    720:          output where only the first processor opens
    721:          the file.  All other processors send their
    722:          data to the first processor to print.

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

    727:    Level: beginner

    729: .seealso: DSViewMat()
    730: @*/
    731: PetscErrorCode DSView(DS ds,PetscViewer viewer)
    732: {
    733:   PetscBool         isascii,issvd;
    734:   const char        *state;
    735:   PetscViewerFormat format;
    736:   PetscErrorCode    ierr;

    740:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)ds));
    743:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    744:   if (isascii) {
    745:     PetscViewerGetFormat(viewer,&format);
    746:     PetscObjectPrintClassNamePrefixType((PetscObject)ds,viewer);
    747:     if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
    748:       switch (ds->state) {
    749:         case DS_STATE_RAW:          state = "raw"; break;
    750:         case DS_STATE_INTERMEDIATE: state = "intermediate"; break;
    751:         case DS_STATE_CONDENSED:    state = "condensed"; break;
    752:         case DS_STATE_TRUNCATED:    state = "truncated"; break;
    753:         default: SETERRQ(PetscObjectComm((PetscObject)ds),1,"Wrong value of ds->state");
    754:       }
    755:       PetscViewerASCIIPrintf(viewer,"  current state: %s\n",state);
    756:       PetscObjectTypeCompare((PetscObject)ds,DSSVD,&issvd);
    757:       if (issvd) {
    758:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%D, n=%D, m=%D, l=%D, k=%D",ds->ld,ds->n,ds->m,ds->l,ds->k);
    759:       } else {
    760:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%D, n=%D, l=%D, k=%D",ds->ld,ds->n,ds->l,ds->k);
    761:       }
    762:       if (ds->state==DS_STATE_TRUNCATED) {
    763:         PetscViewerASCIIPrintf(viewer,", t=%D\n",ds->t);
    764:       } else {
    765:         PetscViewerASCIIPrintf(viewer,"\n");
    766:       }
    767:       PetscViewerASCIIPrintf(viewer,"  flags:%s%s%s\n",ds->compact?" compact":"",ds->extrarow?" extrarow":"",ds->refined?" refined":"");
    768:     }
    769:     if (ds->ops->view) {
    770:       PetscViewerASCIIPushTab(viewer);
    771:       (*ds->ops->view)(ds,viewer);
    772:       PetscViewerASCIIPopTab(viewer);
    773:     }
    774:   }
    775:   return(0);
    776: }

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

    783:    Logically Collective on DS

    785:    Input Parameters:
    786: +  ds - the direct solver context
    787: -  ld - leading dimension (maximum allowed dimension for the matrices, including
    788:         the extra row if present)

    790:    Level: intermediate

    792: .seealso: DSGetLeadingDimension(), DSSetDimensions(), DSSetExtraRow()
    793: @*/
    794: PetscErrorCode DSAllocate(DS ds,PetscInt ld)
    795: {

    801:   if (ld<1) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Leading dimension should be at least one");
    802:   ds->ld = ld;
    803:   (*ds->ops->allocate)(ds,ld);
    804:   return(0);
    805: }

    809: /*@
    810:    DSReset - Resets the DS context to the initial state.

    812:    Collective on DS

    814:    Input Parameter:
    815: .  ds - the direct solver context

    817:    Level: advanced

    819: .seealso: DSDestroy()
    820: @*/
    821: PetscErrorCode DSReset(DS ds)
    822: {
    823:   PetscInt       i;

    828:   ds->state    = DS_STATE_RAW;
    829:   ds->compact  = PETSC_FALSE;
    830:   ds->refined  = PETSC_FALSE;
    831:   ds->extrarow = PETSC_FALSE;
    832:   ds->ld       = 0;
    833:   ds->l        = 0;
    834:   ds->n        = 0;
    835:   ds->m        = 0;
    836:   ds->k        = 0;
    837:   for (i=0;i<DS_NUM_MAT;i++) {
    838:     PetscFree(ds->mat[i]);
    839:     PetscFree(ds->rmat[i]);
    840:     MatDestroy(&ds->omat[i]);
    841:   }
    842:   PetscFree(ds->perm);
    843:   PetscFree(ds->work);
    844:   PetscFree(ds->rwork);
    845:   PetscFree(ds->iwork);
    846:   ds->lwork         = 0;
    847:   ds->lrwork        = 0;
    848:   ds->liwork        = 0;
    849:   return(0);
    850: }

    854: /*@
    855:    DSDestroy - Destroys DS context that was created with DSCreate().

    857:    Collective on DS

    859:    Input Parameter:
    860: .  ds - the direct solver context

    862:    Level: beginner

    864: .seealso: DSCreate()
    865: @*/
    866: PetscErrorCode DSDestroy(DS *ds)
    867: {

    871:   if (!*ds) return(0);
    873:   if (--((PetscObject)(*ds))->refct > 0) { *ds = 0; return(0); }
    874:   DSReset(*ds);
    875:   if ((*ds)->ops->destroy) { (*(*ds)->ops->destroy)(*ds); }
    876:   PetscFree((*ds)->sc);
    877:   PetscHeaderDestroy(ds);
    878:   return(0);
    879: }

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

    886:    Not collective

    888:    Input Parameters:
    889: +  name - name of a new user-defined DS
    890: -  routine_create - routine to create context

    892:    Notes:
    893:    DSRegister() may be called multiple times to add several user-defined
    894:    direct solvers.

    896:    Level: advanced

    898: .seealso: DSRegisterAll()
    899: @*/
    900: PetscErrorCode DSRegister(const char *name,PetscErrorCode (*function)(DS))
    901: {

    905:   PetscFunctionListAdd(&DSList,name,function);
    906:   return(0);
    907: }

    909: PETSC_EXTERN PetscErrorCode DSCreate_HEP(DS);
    910: PETSC_EXTERN PetscErrorCode DSCreate_NHEP(DS);
    911: PETSC_EXTERN PetscErrorCode DSCreate_GHEP(DS);
    912: PETSC_EXTERN PetscErrorCode DSCreate_GHIEP(DS);
    913: PETSC_EXTERN PetscErrorCode DSCreate_GNHEP(DS);
    914: PETSC_EXTERN PetscErrorCode DSCreate_SVD(DS);
    915: PETSC_EXTERN PetscErrorCode DSCreate_PEP(DS);
    916: PETSC_EXTERN PetscErrorCode DSCreate_NEP(DS);

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

    923:    Not Collective

    925:    Level: advanced
    926: @*/
    927: PetscErrorCode DSRegisterAll(void)
    928: {

    932:   if (DSRegisterAllCalled) return(0);
    933:   DSRegisterAllCalled = PETSC_TRUE;
    934:   DSRegister(DSHEP,DSCreate_HEP);
    935:   DSRegister(DSNHEP,DSCreate_NHEP);
    936:   DSRegister(DSGHEP,DSCreate_GHEP);
    937:   DSRegister(DSGHIEP,DSCreate_GHIEP);
    938:   DSRegister(DSGNHEP,DSCreate_GNHEP);
    939:   DSRegister(DSSVD,DSCreate_SVD);
    940:   DSRegister(DSPEP,DSCreate_PEP);
    941:   DSRegister(DSNEP,DSCreate_NEP);
    942:   return(0);
    943: }