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