Actual source code: svdbasic.c

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-, 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 SVD routines
     12: */

     14: #include <slepc/private/svdimpl.h>

     16: /* Logging support */
     17: PetscClassId      SVD_CLASSID = 0;
     18: PetscLogEvent     SVD_SetUp = 0,SVD_Solve = 0;

     20: /* List of registered SVD routines */
     21: PetscFunctionList SVDList = NULL;
     22: PetscBool         SVDRegisterAllCalled = PETSC_FALSE;

     24: /* List of registered SVD monitors */
     25: PetscFunctionList SVDMonitorList              = NULL;
     26: PetscFunctionList SVDMonitorCreateList        = NULL;
     27: PetscFunctionList SVDMonitorDestroyList       = NULL;
     28: PetscBool         SVDMonitorRegisterAllCalled = PETSC_FALSE;

     30: /*@
     31:    SVDCreate - Creates the `SVD` context.

     33:    Collective

     35:    Input Parameter:
     36: .  comm - MPI communicator

     38:    Output Parameter:
     39: .  outsvd - location to put the `SVD` context

     41:    Note:
     42:    The default `SVD` type is `SVDCROSS`.

     44:    Level: beginner

     46: .seealso: [](ch:svd), `SVDSetUp()`, `SVDSolve()`, `SVDDestroy()`, `SVD`
     47: @*/
     48: PetscErrorCode SVDCreate(MPI_Comm comm,SVD *outsvd)
     49: {
     50:   SVD            svd;

     52:   PetscFunctionBegin;
     53:   PetscAssertPointer(outsvd,2);
     54:   PetscCall(SVDInitializePackage());
     55:   PetscCall(SlepcHeaderCreate(svd,SVD_CLASSID,"SVD","Singular Value Decomposition","SVD",comm,SVDDestroy,SVDView));

     57:   svd->OP               = NULL;
     58:   svd->OPb              = NULL;
     59:   svd->omega            = NULL;
     60:   svd->max_it           = PETSC_DETERMINE;
     61:   svd->nsv              = 0;
     62:   svd->ncv              = PETSC_DETERMINE;
     63:   svd->mpd              = PETSC_DETERMINE;
     64:   svd->nini             = 0;
     65:   svd->ninil            = 0;
     66:   svd->tol              = PETSC_DETERMINE;
     67:   svd->thres            = 0.0;
     68:   svd->threlative       = PETSC_FALSE;
     69:   svd->conv             = (SVDConv)-1;
     70:   svd->stop             = SVD_STOP_BASIC;
     71:   svd->which            = SVD_LARGEST;
     72:   svd->problem_type     = (SVDProblemType)0;
     73:   svd->impltrans        = PETSC_FALSE;
     74:   svd->trackall         = PETSC_FALSE;

     76:   svd->converged        = NULL;
     77:   svd->convergeduser    = NULL;
     78:   svd->convergeddestroy = NULL;
     79:   svd->stopping         = SVDStoppingBasic;
     80:   svd->stoppinguser     = NULL;
     81:   svd->stoppingdestroy  = NULL;
     82:   svd->convergedctx     = NULL;
     83:   svd->stoppingctx      = NULL;
     84:   svd->numbermonitors   = 0;

     86:   svd->ds               = NULL;
     87:   svd->U                = NULL;
     88:   svd->V                = NULL;
     89:   svd->A                = NULL;
     90:   svd->B                = NULL;
     91:   svd->AT               = NULL;
     92:   svd->BT               = NULL;
     93:   svd->IS               = NULL;
     94:   svd->ISL              = NULL;
     95:   svd->sigma            = NULL;
     96:   svd->errest           = NULL;
     97:   svd->sign             = NULL;
     98:   svd->perm             = NULL;
     99:   svd->nworkl           = 0;
    100:   svd->nworkr           = 0;
    101:   svd->workl            = NULL;
    102:   svd->workr            = NULL;
    103:   svd->data             = NULL;

    105:   svd->state            = SVD_STATE_INITIAL;
    106:   svd->nconv            = 0;
    107:   svd->its              = 0;
    108:   svd->leftbasis        = PETSC_FALSE;
    109:   svd->swapped          = PETSC_FALSE;
    110:   svd->expltrans        = PETSC_FALSE;
    111:   svd->nrma             = 0.0;
    112:   svd->nrmb             = 0.0;
    113:   svd->isgeneralized    = PETSC_FALSE;
    114:   svd->reason           = SVD_CONVERGED_ITERATING;

    116:   PetscCall(PetscNew(&svd->sc));
    117:   *outsvd = svd;
    118:   PetscFunctionReturn(PETSC_SUCCESS);
    119: }

    121: /*@
    122:    SVDReset - Resets the `SVD` context to the initial state (prior to setup)
    123:    and destroys any allocated `Vec`s and `Mat`s.

    125:    Collective

    127:    Input Parameter:
    128: .  svd - the singular value solver context

    130:    Level: advanced

    132: .seealso: [](ch:svd), `SVDDestroy()`
    133: @*/
    134: PetscErrorCode SVDReset(SVD svd)
    135: {
    136:   PetscFunctionBegin;
    138:   if (!svd) PetscFunctionReturn(PETSC_SUCCESS);
    139:   PetscTryTypeMethod(svd,reset);
    140:   PetscCall(MatDestroy(&svd->OP));
    141:   PetscCall(MatDestroy(&svd->OPb));
    142:   PetscCall(VecDestroy(&svd->omega));
    143:   PetscCall(MatDestroy(&svd->A));
    144:   PetscCall(MatDestroy(&svd->B));
    145:   PetscCall(MatDestroy(&svd->AT));
    146:   PetscCall(MatDestroy(&svd->BT));
    147:   PetscCall(BVDestroy(&svd->U));
    148:   PetscCall(BVDestroy(&svd->V));
    149:   PetscCall(VecDestroyVecs(svd->nworkl,&svd->workl));
    150:   svd->nworkl = 0;
    151:   PetscCall(VecDestroyVecs(svd->nworkr,&svd->workr));
    152:   svd->nworkr = 0;
    153:   svd->swapped = PETSC_FALSE;
    154:   svd->state = SVD_STATE_INITIAL;
    155:   PetscFunctionReturn(PETSC_SUCCESS);
    156: }

    158: /*@
    159:    SVDDestroy - Destroys the `SVD` context.

    161:    Collective

    163:    Input Parameter:
    164: .  svd - the singular value solver context

    166:    Level: beginner

    168: .seealso: [](ch:svd), `SVDCreate()`, `SVDSetUp()`, `SVDSolve()`
    169: @*/
    170: PetscErrorCode SVDDestroy(SVD *svd)
    171: {
    172:   PetscFunctionBegin;
    173:   if (!*svd) PetscFunctionReturn(PETSC_SUCCESS);
    175:   if (--((PetscObject)*svd)->refct > 0) { *svd = NULL; PetscFunctionReturn(PETSC_SUCCESS); }
    176:   PetscCall(SVDReset(*svd));
    177:   PetscTryTypeMethod(*svd,destroy);
    178:   if ((*svd)->sigma) PetscCall(PetscFree3((*svd)->sigma,(*svd)->perm,(*svd)->errest));
    179:   if ((*svd)->sign) PetscCall(PetscFree((*svd)->sign));
    180:   PetscCall(DSDestroy(&(*svd)->ds));
    181:   PetscCall(PetscFree((*svd)->sc));
    182:   /* just in case the initial vectors have not been used */
    183:   PetscCall(SlepcBasisDestroy_Private(&(*svd)->nini,&(*svd)->IS));
    184:   PetscCall(SlepcBasisDestroy_Private(&(*svd)->ninil,&(*svd)->ISL));
    185:   if ((*svd)->convergeddestroy) PetscCall((*(*svd)->convergeddestroy)(&(*svd)->convergedctx));
    186:   if ((*svd)->stoppingdestroy) PetscCall((*(*svd)->stoppingdestroy)(&(*svd)->stoppingctx));
    187:   PetscCall(SVDMonitorCancel(*svd));
    188:   PetscCall(PetscHeaderDestroy(svd));
    189:   PetscFunctionReturn(PETSC_SUCCESS);
    190: }

    192: /*@
    193:    SVDSetType - Selects the particular solver to be used in the `SVD` object.

    195:    Logically Collective

    197:    Input Parameters:
    198: +  svd      - the singular value solver context
    199: -  type     - a known method

    201:    Options Database Key:
    202: .  -svd_type \<type\> - sets the method; use `-help` for a list of available methods

    204:    Notes:
    205:    See `SVDType` for available methods. The default is `SVDCROSS`.

    207:    Normally, it is best to use the `SVDSetFromOptions()` command and
    208:    then set the `SVD` type from the options database rather than by using
    209:    this routine.  Using the options database provides the user with
    210:    maximum flexibility in evaluating the different available methods.
    211:    The `SVDSetType()` routine is provided for those situations where it
    212:    is necessary to set the iterative solver independently of the command
    213:    line or options database.

    215:    Level: intermediate

    217: .seealso: [](ch:svd), `SVDType`
    218: @*/
    219: PetscErrorCode SVDSetType(SVD svd,SVDType type)
    220: {
    221:   PetscErrorCode (*r)(SVD);
    222:   PetscBool      match;

    224:   PetscFunctionBegin;
    226:   PetscAssertPointer(type,2);

    228:   PetscCall(PetscObjectTypeCompare((PetscObject)svd,type,&match));
    229:   if (match) PetscFunctionReturn(PETSC_SUCCESS);

    231:   PetscCall(PetscFunctionListFind(SVDList,type,&r));
    232:   PetscCheck(r,PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown SVD type given: %s",type);

    234:   PetscTryTypeMethod(svd,destroy);
    235:   PetscCall(PetscMemzero(svd->ops,sizeof(struct _SVDOps)));

    237:   svd->state = SVD_STATE_INITIAL;
    238:   PetscCall(PetscObjectChangeTypeName((PetscObject)svd,type));
    239:   PetscCall((*r)(svd));
    240:   PetscFunctionReturn(PETSC_SUCCESS);
    241: }

    243: /*@
    244:    SVDGetType - Gets the `SVD` type as a string from the `SVD` object.

    246:    Not Collective

    248:    Input Parameter:
    249: .  svd - the singular value solver context

    251:    Output Parameter:
    252: .  type - name of `SVD` method

    254:    Level: intermediate

    256: .seealso: [](ch:svd), `SVDSetType()`
    257: @*/
    258: PetscErrorCode SVDGetType(SVD svd,SVDType *type)
    259: {
    260:   PetscFunctionBegin;
    262:   PetscAssertPointer(type,2);
    263:   *type = ((PetscObject)svd)->type_name;
    264:   PetscFunctionReturn(PETSC_SUCCESS);
    265: }

    267: /*@C
    268:    SVDRegister - Adds a method to the singular value solver package.

    270:    Not Collective

    272:    Input Parameters:
    273: +  name - name of a new user-defined solver
    274: -  function - routine to create the solver context

    276:    Note:
    277:    `SVDRegister()` may be called multiple times to add several user-defined solvers.

    279:    Example Usage:
    280: .vb
    281:    SVDRegister("my_solver",MySolverCreate);
    282: .ve

    284:    Then, your solver can be chosen with the procedural interface via
    285: .vb
    286:    SVDSetType(svd,"my_solver")
    287: .ve
    288:    or at runtime via the option `-svd_type my_solver`.

    290:    Level: advanced

    292: .seealso: [](ch:svd), `SVDRegisterAll()`
    293: @*/
    294: PetscErrorCode SVDRegister(const char *name,PetscErrorCode (*function)(SVD))
    295: {
    296:   PetscFunctionBegin;
    297:   PetscCall(SVDInitializePackage());
    298:   PetscCall(PetscFunctionListAdd(&SVDList,name,function));
    299:   PetscFunctionReturn(PETSC_SUCCESS);
    300: }

    302: /*@C
    303:    SVDMonitorRegister - Registers an `SVD` monitor routine that may be accessed with
    304:    `SVDMonitorSetFromOptions()`.

    306:    Not Collective

    308:    Input Parameters:
    309: +  name    - name of a new monitor routine
    310: .  vtype   - a `PetscViewerType` for the output
    311: .  format  - a `PetscViewerFormat` for the output
    312: .  monitor - monitor routine, see `SVDMonitorRegisterFn`
    313: .  create  - creation routine, or `NULL`
    314: -  destroy - destruction routine, or `NULL`

    316:    Notes:
    317:    `SVDMonitorRegister()` may be called multiple times to add several user-defined monitors.

    319:    The calling sequence for the given function matches the calling sequence of `SVDMonitorFn`
    320:    functions passed to `SVDMonitorSet()` with the additional requirement that its final argument
    321:    be a `PetscViewerAndFormat`.

    323:    Example Usage:
    324: .vb
    325:    SVDMonitorRegister("my_monitor",PETSCVIEWERASCII,PETSC_VIEWER_ASCII_INFO_DETAIL,MyMonitor,NULL,NULL);
    326: .ve

    328:    Then, your monitor can be chosen with the procedural interface via
    329: .vb
    330:    SVDMonitorSetFromOptions(svd,"-svd_monitor_my_monitor","my_monitor",NULL);
    331: .ve
    332:    or at runtime via the option `-svd_monitor_my_monitor`.

    334:    Level: advanced

    336: .seealso: [](ch:svd), `SVDMonitorSet()`, `SVDMonitorRegisterAll()`, `SVDMonitorSetFromOptions()`
    337: @*/
    338: PetscErrorCode SVDMonitorRegister(const char name[],PetscViewerType vtype,PetscViewerFormat format,SVDMonitorRegisterFn *monitor,SVDMonitorRegisterCreateFn *create,SVDMonitorRegisterDestroyFn *destroy)
    339: {
    340:   char           key[PETSC_MAX_PATH_LEN];

    342:   PetscFunctionBegin;
    343:   PetscCall(SVDInitializePackage());
    344:   PetscCall(SlepcMonitorMakeKey_Internal(name,vtype,format,key));
    345:   PetscCall(PetscFunctionListAdd(&SVDMonitorList,key,monitor));
    346:   if (create)  PetscCall(PetscFunctionListAdd(&SVDMonitorCreateList,key,create));
    347:   if (destroy) PetscCall(PetscFunctionListAdd(&SVDMonitorDestroyList,key,destroy));
    348:   PetscFunctionReturn(PETSC_SUCCESS);
    349: }

    351: /*@
    352:    SVDSetBV - Associates basis vectors objects to the singular value solver.

    354:    Collective

    356:    Input Parameters:
    357: +  svd - the singular value solver context
    358: .  V   - the basis vectors object for right singular vectors
    359: -  U   - the basis vectors object for left singular vectors

    361:    Note:
    362:    Use `SVDGetBV()` to retrieve the basis vectors contexts (for example,
    363:    to free them at the end of the computations).

    365:    Level: advanced

    367: .seealso: [](ch:svd), `SVDGetBV()`
    368: @*/
    369: PetscErrorCode SVDSetBV(SVD svd,BV V,BV U)
    370: {
    371:   PetscFunctionBegin;
    373:   if (V) {
    375:     PetscCheckSameComm(svd,1,V,2);
    376:     PetscCall(PetscObjectReference((PetscObject)V));
    377:     PetscCall(BVDestroy(&svd->V));
    378:     svd->V = V;
    379:   }
    380:   if (U) {
    382:     PetscCheckSameComm(svd,1,U,3);
    383:     PetscCall(PetscObjectReference((PetscObject)U));
    384:     PetscCall(BVDestroy(&svd->U));
    385:     svd->U = U;
    386:   }
    387:   PetscFunctionReturn(PETSC_SUCCESS);
    388: }

    390: /*@
    391:    SVDGetBV - Obtain the basis vectors objects associated to the singular
    392:    value solver object.

    394:    Not Collective

    396:    Input Parameter:
    397: .  svd - the singular value solver context

    399:    Output Parameters:
    400: +  V - basis vectors context for right singular vectors
    401: -  U - basis vectors context for left singular vectors

    403:    Level: advanced

    405: .seealso: [](ch:svd), `SVDSetBV()`
    406: @*/
    407: PetscErrorCode SVDGetBV(SVD svd,BV *V,BV *U)
    408: {
    409:   PetscFunctionBegin;
    411:   if (V) {
    412:     if (!svd->V) {
    413:       PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&svd->V));
    414:       PetscCall(PetscObjectIncrementTabLevel((PetscObject)svd->V,(PetscObject)svd,0));
    415:       PetscCall(PetscObjectSetOptions((PetscObject)svd->V,((PetscObject)svd)->options));
    416:     }
    417:     *V = svd->V;
    418:   }
    419:   if (U) {
    420:     if (!svd->U) {
    421:       PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&svd->U));
    422:       PetscCall(PetscObjectIncrementTabLevel((PetscObject)svd->U,(PetscObject)svd,0));
    423:       PetscCall(PetscObjectSetOptions((PetscObject)svd->U,((PetscObject)svd)->options));
    424:     }
    425:     *U = svd->U;
    426:   }
    427:   PetscFunctionReturn(PETSC_SUCCESS);
    428: }

    430: /*@
    431:    SVDSetDS - Associates a direct solver object to the singular value solver.

    433:    Collective

    435:    Input Parameters:
    436: +  svd - the singular value solver context
    437: -  ds  - the direct solver object

    439:    Note:
    440:    Use `SVDGetDS()` to retrieve the direct solver context (for example,
    441:    to free it at the end of the computations).

    443:    Level: advanced

    445: .seealso: [](ch:svd), `SVDGetDS()`
    446: @*/
    447: PetscErrorCode SVDSetDS(SVD svd,DS ds)
    448: {
    449:   PetscFunctionBegin;
    452:   PetscCheckSameComm(svd,1,ds,2);
    453:   PetscCall(PetscObjectReference((PetscObject)ds));
    454:   PetscCall(DSDestroy(&svd->ds));
    455:   svd->ds = ds;
    456:   PetscFunctionReturn(PETSC_SUCCESS);
    457: }

    459: /*@
    460:    SVDGetDS - Obtain the direct solver object associated to the singular value
    461:    solver object.

    463:    Not Collective

    465:    Input Parameter:
    466: .  svd - the singular value solver context

    468:    Output Parameter:
    469: .  ds - direct solver context

    471:    Level: advanced

    473: .seealso: [](ch:svd), `SVDSetDS()`
    474: @*/
    475: PetscErrorCode SVDGetDS(SVD svd,DS *ds)
    476: {
    477:   PetscFunctionBegin;
    479:   PetscAssertPointer(ds,2);
    480:   if (!svd->ds) {
    481:     PetscCall(DSCreate(PetscObjectComm((PetscObject)svd),&svd->ds));
    482:     PetscCall(PetscObjectIncrementTabLevel((PetscObject)svd->ds,(PetscObject)svd,0));
    483:     PetscCall(PetscObjectSetOptions((PetscObject)svd->ds,((PetscObject)svd)->options));
    484:   }
    485:   *ds = svd->ds;
    486:   PetscFunctionReturn(PETSC_SUCCESS);
    487: }