Actual source code: dsbasic.c

slepc-3.10.0 2018-09-18
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-2018, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */
 10: /*
 11:    Basic DS routines
 12: */

 14: #include <slepc/private/dsimpl.h>      /*I "slepcds.h" I*/

 16: PetscFunctionList DSList = 0;
 17: PetscBool         DSRegisterAllCalled = PETSC_FALSE;
 18: PetscClassId      DS_CLASSID = 0;
 19: PetscLogEvent     DS_Solve = 0,DS_Vectors = 0,DS_Synchronize = 0,DS_Other = 0;
 20: static PetscBool  DSPackageInitialized = PETSC_FALSE;

 22: const char *DSStateTypes[] = {"RAW","INTERMEDIATE","CONDENSED","TRUNCATED","DSStateType","DS_STATE_",0};
 23: const char *DSParallelTypes[] = {"REDUNDANT","SYNCHRONIZED","DSParallelType","DS_PARALLEL_",0};
 24: 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"};
 25: 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};

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

 31:    Level: developer

 33: .seealso: SlepcFinalize()
 34: @*/
 35: PetscErrorCode DSFinalizePackage(void)
 36: {

 40:   PetscFunctionListDestroy(&DSList);
 41:   DSPackageInitialized = PETSC_FALSE;
 42:   DSRegisterAllCalled  = PETSC_FALSE;
 43:   return(0);
 44: }

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

 51:   Level: developer

 53: .seealso: SlepcInitialize()
 54: @*/
 55: PetscErrorCode DSInitializePackage()
 56: {
 57:   char             logList[256];
 58:   PetscBool      opt,pkg;
 59:   PetscErrorCode   ierr;

 62:   if (DSPackageInitialized) return(0);
 63:   DSPackageInitialized = PETSC_TRUE;
 64:   /* Register Classes */
 65:   PetscClassIdRegister("Direct Solver",&DS_CLASSID);
 66:   /* Register Constructors */
 67:   DSRegisterAll();
 68:   /* Register Events */
 69:   PetscLogEventRegister("DSSolve",DS_CLASSID,&DS_Solve);
 70:   PetscLogEventRegister("DSVectors",DS_CLASSID,&DS_Vectors);
 71:   PetscLogEventRegister("DSSynchronize",DS_CLASSID,&DS_Synchronize);
 72:   PetscLogEventRegister("DSOther",DS_CLASSID,&DS_Other);
 73:   /* Process info exclusions */
 74:   PetscOptionsGetString(NULL,NULL,"-info_exclude",logList,sizeof(logList),&opt);
 75:   if (opt) {
 76:     PetscStrInList("ds",logList,',',&pkg);
 77:     if (pkg) { PetscInfoDeactivateClass(DS_CLASSID); }
 78:   }
 79:   /* Process summary exclusions */
 80:   PetscOptionsGetString(NULL,NULL,"-log_exclude",logList,sizeof(logList),&opt);
 81:   if (opt) {
 82:     PetscStrInList("ds",logList,',',&pkg);
 83:     if (pkg) { PetscLogEventDeactivateClass(DS_CLASSID); }
 84:   }
 85:   /* Register package finalizer */
 86:   PetscRegisterFinalize(DSFinalizePackage);
 87:   return(0);
 88: }

 90: /*@
 91:    DSCreate - Creates a DS context.

 93:    Collective on MPI_Comm

 95:    Input Parameter:
 96: .  comm - MPI communicator

 98:    Output Parameter:
 99: .  newds - location to put the DS context

101:    Level: beginner

103:    Note:
104:    DS objects are not intended for normal users but only for
105:    advanced user that for instance implement their own solvers.

107: .seealso: DSDestroy(), DS
108: @*/
109: PetscErrorCode DSCreate(MPI_Comm comm,DS *newds)
110: {
111:   DS             ds;
112:   PetscInt       i;

117:   *newds = 0;
118:   DSInitializePackage();
119:   SlepcHeaderCreate(ds,DS_CLASSID,"DS","Direct Solver (or Dense System)","DS",comm,DSDestroy,DSView);

121:   ds->state         = DS_STATE_RAW;
122:   ds->method        = 0;
123:   ds->compact       = PETSC_FALSE;
124:   ds->refined       = PETSC_FALSE;
125:   ds->extrarow      = PETSC_FALSE;
126:   ds->ld            = 0;
127:   ds->l             = 0;
128:   ds->n             = 0;
129:   ds->m             = 0;
130:   ds->k             = 0;
131:   ds->t             = 0;
132:   ds->bs            = 1;
133:   ds->sc            = NULL;
134:   ds->pmode         = DS_PARALLEL_REDUNDANT;

136:   for (i=0;i<DS_NUM_MAT;i++) {
137:     ds->mat[i]      = NULL;
138:     ds->rmat[i]     = NULL;
139:     ds->omat[i]     = NULL;
140:   }
141:   ds->perm          = NULL;
142:   ds->data          = NULL;
143:   ds->work          = NULL;
144:   ds->rwork         = NULL;
145:   ds->iwork         = NULL;
146:   ds->lwork         = 0;
147:   ds->lrwork        = 0;
148:   ds->liwork        = 0;

150:   *newds = ds;
151:   return(0);
152: }

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

158:    Logically Collective on DS

160:    Input Parameters:
161: +  ds - the direct solver context
162: -  prefix - the prefix string to prepend to all DS 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: DSAppendOptionsPrefix()
172: @*/
173: PetscErrorCode DSSetOptionsPrefix(DS ds,const char *prefix)
174: {

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

183: /*@C
184:    DSAppendOptionsPrefix - Appends to the prefix used for searching for all
185:    DS options in the database.

187:    Logically Collective on DS

189:    Input Parameters:
190: +  ds - the direct solver context
191: -  prefix - the prefix string to prepend to all DS option requests

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

197:    Level: advanced

199: .seealso: DSSetOptionsPrefix()
200: @*/
201: PetscErrorCode DSAppendOptionsPrefix(DS ds,const char *prefix)
202: {

207:   PetscObjectAppendOptionsPrefix((PetscObject)ds,prefix);
208:   return(0);
209: }

211: /*@C
212:    DSGetOptionsPrefix - Gets the prefix used for searching for all
213:    DS options in the database.

215:    Not Collective

217:    Input Parameters:
218: .  ds - the direct solver context

220:    Output Parameters:
221: .  prefix - pointer to the prefix string used is returned

223:    Note:
224:    On the Fortran side, the user should pass in a string 'prefix' of
225:    sufficient length to hold the prefix.

227:    Level: advanced

229: .seealso: DSSetOptionsPrefix(), DSAppendOptionsPrefix()
230: @*/
231: PetscErrorCode DSGetOptionsPrefix(DS ds,const char *prefix[])
232: {

238:   PetscObjectGetOptionsPrefix((PetscObject)ds,prefix);
239:   return(0);
240: }

242: /*@C
243:    DSSetType - Selects the type for the DS object.

245:    Logically Collective on DS

247:    Input Parameter:
248: +  ds   - the direct solver context
249: -  type - a known type

251:    Level: intermediate

253: .seealso: DSGetType()
254: @*/
255: PetscErrorCode DSSetType(DS ds,DSType type)
256: {
257:   PetscErrorCode ierr,(*r)(DS);
258:   PetscBool      match;


264:   PetscObjectTypeCompare((PetscObject)ds,type,&match);
265:   if (match) return(0);

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

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

272:   PetscObjectChangeTypeName((PetscObject)ds,type);
273:   (*r)(ds);
274:   return(0);
275: }

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

280:    Not Collective

282:    Input Parameter:
283: .  ds - the direct solver context

285:    Output Parameter:
286: .  name - name of the direct solver

288:    Level: intermediate

290: .seealso: DSSetType()
291: @*/
292: PetscErrorCode DSGetType(DS ds,DSType *type)
293: {
297:   *type = ((PetscObject)ds)->type_name;
298:   return(0);
299: }

301: /*@
302:    DSSetMethod - Selects the method to be used to solve the problem.

304:    Logically Collective on DS

306:    Input Parameter:
307: +  ds   - the direct solver context
308: -  meth - an index indentifying the method

310:    Options Database Key:
311: .  -ds_method <meth> - Sets the method

313:    Level: intermediate

315: .seealso: DSGetMethod()
316: @*/
317: PetscErrorCode DSSetMethod(DS ds,PetscInt meth)
318: {
322:   if (meth<0) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The method must be a non-negative integer");
323:   if (meth>DS_MAX_SOLVE) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Too large value for the method");
324:   ds->method = meth;
325:   return(0);
326: }

328: /*@
329:    DSGetMethod - Gets the method currently used in the DS.

331:    Not Collective

333:    Input Parameter:
334: .  ds - the direct solver context

336:    Output Parameter:
337: .  meth - identifier of the method

339:    Level: intermediate

341: .seealso: DSSetMethod()
342: @*/
343: PetscErrorCode DSGetMethod(DS ds,PetscInt *meth)
344: {
348:   *meth = ds->method;
349:   return(0);
350: }

352: /*@
353:    DSSetParallel - Selects the mode of operation in parallel runs.

355:    Logically Collective on DS

357:    Input Parameter:
358: +  ds    - the direct solver context
359: -  pmode - the parallel mode

361:    Options Database Key:
362: .  -ds_parallel <mode> - Sets the parallel mode, either 'redundant' or 'synchronized'

364:    Notes:
365:    In the 'redundant' parallel mode, all processes will make the computation
366:    redundantly, starting from the same data, and producing the same result.
367:    This result may be slightly different in the different processes if using a
368:    multithreaded BLAS library, which may cause issues in ill-conditioned problems.

370:    In the 'synchronized' parallel mode, only the first MPI process performs the
371:    computation and then the computed quantities are broadcast to the other
372:    processes in the communicator. This communication is not done automatically,
373:    an explicit call to DSSynchronize() is required.

375:    Level: advanced

377: .seealso: DSSynchronize(), DSGetParallel()
378: @*/
379: PetscErrorCode DSSetParallel(DS ds,DSParallelType pmode)
380: {
384:   ds->pmode = pmode;
385:   return(0);
386: }

388: /*@
389:    DSGetParallel - Gets the mode of operation in parallel runs.

391:    Not Collective

393:    Input Parameter:
394: .  ds - the direct solver context

396:    Output Parameter:
397: .  pmode - the parallel mode

399:    Level: advanced

401: .seealso: DSSetParallel()
402: @*/
403: PetscErrorCode DSGetParallel(DS ds,DSParallelType *pmode)
404: {
408:   *pmode = ds->pmode;
409:   return(0);
410: }

412: /*@
413:    DSSetCompact - Switch to compact storage of matrices.

415:    Logically Collective on DS

417:    Input Parameter:
418: +  ds   - the direct solver context
419: -  comp - a boolean flag

421:    Notes:
422:    Compact storage is used in some DS types such as DSHEP when the matrix
423:    is tridiagonal. This flag can be used to indicate whether the user
424:    provides the matrix entries via the compact form (the tridiagonal DS_MAT_T)
425:    or the non-compact one (DS_MAT_A).

427:    The default is PETSC_FALSE.

429:    Level: advanced

431: .seealso: DSGetCompact()
432: @*/
433: PetscErrorCode DSSetCompact(DS ds,PetscBool comp)
434: {
438:   ds->compact = comp;
439:   return(0);
440: }

442: /*@
443:    DSGetCompact - Gets the compact storage flag.

445:    Not Collective

447:    Input Parameter:
448: .  ds - the direct solver context

450:    Output Parameter:
451: .  comp - the flag

453:    Level: advanced

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

466: /*@
467:    DSSetExtraRow - Sets a flag to indicate that the matrix has one extra
468:    row.

470:    Logically Collective on DS

472:    Input Parameter:
473: +  ds  - the direct solver context
474: -  ext - a boolean flag

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

482:    The default is PETSC_FALSE.

484:    Level: advanced

486: .seealso: DSSolve(), DSAllocate(), DSGetExtraRow()
487: @*/
488: PetscErrorCode DSSetExtraRow(DS ds,PetscBool ext)
489: {
493:   if (ds->n>0 && ds->n==ds->ld) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ORDER,"Cannot set extra row after setting n=ld");
494:   ds->extrarow = ext;
495:   return(0);
496: }

498: /*@
499:    DSGetExtraRow - Gets the extra row flag.

501:    Not Collective

503:    Input Parameter:
504: .  ds - the direct solver context

506:    Output Parameter:
507: .  ext - the flag

509:    Level: advanced

511: .seealso: DSSetExtraRow()
512: @*/
513: PetscErrorCode DSGetExtraRow(DS ds,PetscBool *ext)
514: {
518:   *ext = ds->extrarow;
519:   return(0);
520: }

522: /*@
523:    DSSetRefined - Sets a flag to indicate that refined vectors must be
524:    computed.

526:    Logically Collective on DS

528:    Input Parameter:
529: +  ds  - the direct solver context
530: -  ref - a boolean flag

532:    Notes:
533:    Normally the vectors returned in DS_MAT_X are eigenvectors of the
534:    projected matrix. With this flag activated, DSVectors() will return
535:    the right singular vector of the smallest singular value of matrix
536:    \tilde{A}-theta*I, where \tilde{A} is the extended (n+1)xn matrix
537:    and theta is the Ritz value. This is used in the refined Ritz
538:    approximation.

540:    The default is PETSC_FALSE.

542:    Level: advanced

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

555: /*@
556:    DSGetRefined - Gets the refined vectors flag.

558:    Not Collective

560:    Input Parameter:
561: .  ds - the direct solver context

563:    Output Parameter:
564: .  ref - the flag

566:    Level: advanced

568: .seealso: DSSetRefined()
569: @*/
570: PetscErrorCode DSGetRefined(DS ds,PetscBool *ref)
571: {
575:   *ref = ds->refined;
576:   return(0);
577: }

579: /*@
580:    DSSetBlockSize - Sets the block size.

582:    Logically Collective on DS

584:    Input Parameter:
585: +  ds - the direct solver context
586: -  bs - the block size

588:    Options Database Key:
589: .  -ds_block_size <bs> - Sets the block size

591:    Level: intermediate

593: .seealso: DSGetBlockSize()
594: @*/
595: PetscErrorCode DSSetBlockSize(DS ds,PetscInt bs)
596: {
600:   if (bs<1) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The block size must be at least one");
601:   ds->bs = bs;
602:   return(0);
603: }

605: /*@
606:    DSGetBlockSize - Gets the block size.

608:    Not Collective

610:    Input Parameter:
611: .  ds - the direct solver context

613:    Output Parameter:
614: .  bs - block size

616:    Level: intermediate

618: .seealso: DSSetBlockSize()
619: @*/
620: PetscErrorCode DSGetBlockSize(DS ds,PetscInt *bs)
621: {
625:   *bs = ds->bs;
626:   return(0);
627: }

629: /*@C
630:    DSSetSlepcSC - Sets the sorting criterion context.

632:    Not Collective

634:    Input Parameters:
635: +  ds - the direct solver context
636: -  sc - a pointer to the sorting criterion context

638:    Level: developer

640: .seealso: DSGetSlepcSC(), DSSort()
641: @*/
642: PetscErrorCode DSSetSlepcSC(DS ds,SlepcSC sc)
643: {

649:   if (ds->sc) {
650:     PetscFree(ds->sc);
651:   }
652:   ds->sc = sc;
653:   return(0);
654: }

656: /*@C
657:    DSGetSlepcSC - Gets the sorting criterion context.

659:    Not Collective

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

664:    Output Parameters:
665: .  sc - a pointer to the sorting criterion context

667:    Level: developer

669: .seealso: DSSetSlepcSC(), DSSort()
670: @*/
671: PetscErrorCode DSGetSlepcSC(DS ds,SlepcSC *sc)
672: {

678:   if (!ds->sc) {
679:     PetscNewLog(ds,&ds->sc);
680:   }
681:   *sc = ds->sc;
682:   return(0);
683: }

685: /*@
686:    DSSetFromOptions - Sets DS options from the options database.

688:    Collective on DS

690:    Input Parameters:
691: .  ds - the direct solver context

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

696:    Level: beginner
697: @*/
698: PetscErrorCode DSSetFromOptions(DS ds)
699: {
701:   PetscInt       bs,meth;
702:   PetscBool      flag;
703:   DSParallelType pmode;

707:   DSRegisterAll();
708:   /* Set default type (we do not allow changing it with -ds_type) */
709:   if (!((PetscObject)ds)->type_name) {
710:     DSSetType(ds,DSNHEP);
711:   }
712:   PetscObjectOptionsBegin((PetscObject)ds);

714:     PetscOptionsInt("-ds_block_size","Block size for the dense system solver","DSSetBlockSize",ds->bs,&bs,&flag);
715:     if (flag) { DSSetBlockSize(ds,bs); }

717:     PetscOptionsInt("-ds_method","Method to be used for the dense system","DSSetMethod",ds->method,&meth,&flag);
718:     if (flag) { DSSetMethod(ds,meth); }

720:     PetscOptionsEnum("-ds_parallel","Operation mode in parallel runs","DSSetParallel",DSParallelTypes,(PetscEnum)ds->pmode,(PetscEnum*)&pmode,&flag);
721:     if (flag) { DSSetParallel(ds,pmode); }

723:     PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)ds);
724:   PetscOptionsEnd();
725:   return(0);
726: }

728: /*@C
729:    DSView - Prints the DS data structure.

731:    Collective on DS

733:    Input Parameters:
734: +  ds - the direct solver context
735: -  viewer - optional visualization context

737:    Note:
738:    The available visualization contexts include
739: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
740: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
741:          output where only the first processor opens
742:          the file.  All other processors send their
743:          data to the first processor to print.

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

748:    Level: beginner

750: .seealso: DSViewMat()
751: @*/
752: PetscErrorCode DSView(DS ds,PetscViewer viewer)
753: {
754:   PetscBool         isascii,issvd;
755:   PetscInt          tabs;
756:   PetscViewerFormat format;
757:   PetscErrorCode    ierr;
758:   PetscMPIInt       size;

762:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)ds));
765:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
766:   if (isascii) {
767:     PetscViewerASCIIGetTab(viewer,&tabs);
768:     PetscViewerASCIISetTab(viewer,((PetscObject)ds)->tablevel);
769:     PetscViewerGetFormat(viewer,&format);
770:     PetscObjectPrintClassNamePrefixType((PetscObject)ds,viewer);
771:     MPI_Comm_size(PetscObjectComm((PetscObject)ds),&size);
772:     if (size>1) {
773:       PetscViewerASCIIPrintf(viewer,"  parallel operation mode: %s\n",DSParallelTypes[ds->pmode]);
774:     }
775:     if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
776:       PetscViewerASCIIPrintf(viewer,"  current state: %s\n",DSStateTypes[ds->state]);
777:       PetscObjectTypeCompare((PetscObject)ds,DSSVD,&issvd);
778:       if (issvd) {
779:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%D, n=%D, m=%D, l=%D, k=%D",ds->ld,ds->n,ds->m,ds->l,ds->k);
780:       } else {
781:         PetscViewerASCIIPrintf(viewer,"  dimensions: ld=%D, n=%D, l=%D, k=%D",ds->ld,ds->n,ds->l,ds->k);
782:       }
783:       if (ds->state==DS_STATE_TRUNCATED) {
784:         PetscViewerASCIIPrintf(viewer,", t=%D\n",ds->t);
785:       } else {
786:         PetscViewerASCIIPrintf(viewer,"\n");
787:       }
788:       PetscViewerASCIIPrintf(viewer,"  flags:%s%s%s\n",ds->compact?" compact":"",ds->extrarow?" extrarow":"",ds->refined?" refined":"");
789:     }
790:     if (ds->ops->view) {
791:       PetscViewerASCIIPushTab(viewer);
792:       (*ds->ops->view)(ds,viewer);
793:       PetscViewerASCIIPopTab(viewer);
794:     }
795:     PetscViewerASCIISetTab(viewer,tabs);
796:   }
797:   return(0);
798: }

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

803:    Logically Collective on DS

805:    Input Parameters:
806: +  ds - the direct solver context
807: -  ld - leading dimension (maximum allowed dimension for the matrices, including
808:         the extra row if present)

810:    Note:
811:    If the leading dimension is different from a previously set value, then
812:    all matrices are destroyed with DSReset().

814:    Level: intermediate

816: .seealso: DSGetLeadingDimension(), DSSetDimensions(), DSSetExtraRow(), DSReset()
817: @*/
818: PetscErrorCode DSAllocate(DS ds,PetscInt ld)
819: {

826:   if (ld<1) SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Leading dimension should be at least one");
827:   if (ld!=ds->ld) {
828:     DSReset(ds);
829:     ds->ld = ld;
830:     (*ds->ops->allocate)(ds,ld);
831:   }
832:   return(0);
833: }

835: /*@
836:    DSReset - Resets the DS context to the initial state.

838:    Collective on DS

840:    Input Parameter:
841: .  ds - the direct solver context

843:    Note:
844:    All data structures with size depending on the leading dimension
845:    of DSAllocate() are released.

847:    Level: advanced

849: .seealso: DSDestroy(), DSAllocate()
850: @*/
851: PetscErrorCode DSReset(DS ds)
852: {
853:   PetscInt       i;

858:   if (!ds) return(0);
859:   ds->state    = DS_STATE_RAW;
860:   ds->ld       = 0;
861:   ds->l        = 0;
862:   ds->n        = 0;
863:   ds->m        = 0;
864:   ds->k        = 0;
865:   for (i=0;i<DS_NUM_MAT;i++) {
866:     PetscFree(ds->mat[i]);
867:     PetscFree(ds->rmat[i]);
868:     MatDestroy(&ds->omat[i]);
869:   }
870:   PetscFree(ds->perm);
871:   return(0);
872: }

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

877:    Collective on DS

879:    Input Parameter:
880: .  ds - the direct solver context

882:    Level: beginner

884: .seealso: DSCreate()
885: @*/
886: PetscErrorCode DSDestroy(DS *ds)
887: {

891:   if (!*ds) return(0);
893:   if (--((PetscObject)(*ds))->refct > 0) { *ds = 0; return(0); }
894:   DSReset(*ds);
895:   if ((*ds)->ops->destroy) { (*(*ds)->ops->destroy)(*ds); }
896:   PetscFree((*ds)->work);
897:   PetscFree((*ds)->rwork);
898:   PetscFree((*ds)->iwork);
899:   PetscFree((*ds)->sc);
900:   PetscHeaderDestroy(ds);
901:   return(0);
902: }

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

907:    Not collective

909:    Input Parameters:
910: +  name - name of a new user-defined DS
911: -  routine_create - routine to create context

913:    Notes:
914:    DSRegister() may be called multiple times to add several user-defined
915:    direct solvers.

917:    Level: advanced

919: .seealso: DSRegisterAll()
920: @*/
921: PetscErrorCode DSRegister(const char *name,PetscErrorCode (*function)(DS))
922: {

926:   DSInitializePackage();
927:   PetscFunctionListAdd(&DSList,name,function);
928:   return(0);
929: }

931: PETSC_EXTERN PetscErrorCode DSCreate_HEP(DS);
932: PETSC_EXTERN PetscErrorCode DSCreate_NHEP(DS);
933: PETSC_EXTERN PetscErrorCode DSCreate_GHEP(DS);
934: PETSC_EXTERN PetscErrorCode DSCreate_GHIEP(DS);
935: PETSC_EXTERN PetscErrorCode DSCreate_GNHEP(DS);
936: PETSC_EXTERN PetscErrorCode DSCreate_SVD(DS);
937: PETSC_EXTERN PetscErrorCode DSCreate_PEP(DS);
938: PETSC_EXTERN PetscErrorCode DSCreate_NEP(DS);

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

943:    Not Collective

945:    Level: advanced
946: @*/
947: PetscErrorCode DSRegisterAll(void)
948: {

952:   if (DSRegisterAllCalled) return(0);
953:   DSRegisterAllCalled = PETSC_TRUE;
954:   DSRegister(DSHEP,DSCreate_HEP);
955:   DSRegister(DSNHEP,DSCreate_NHEP);
956:   DSRegister(DSGHEP,DSCreate_GHEP);
957:   DSRegister(DSGHIEP,DSCreate_GHIEP);
958:   DSRegister(DSGNHEP,DSCreate_GNHEP);
959:   DSRegister(DSSVD,DSCreate_SVD);
960:   DSRegister(DSPEP,DSCreate_PEP);
961:   DSRegister(DSNEP,DSCreate_NEP);
962:   return(0);
963: }