Date: 2013-09-02T10:06:22+00:00

Actual source code: svdbasic.c

      1: /*
      2:      The basic SVD routines, Create, View, etc. are here.

      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/svdimpl.h>      /*I "slepcsvd.h" I*/

     26: PetscFunctionList SVDList = 0;
     27: PetscBool         SVDRegisterAllCalled = PETSC_FALSE;
     28: PetscClassId      SVD_CLASSID = 0;
     29: PetscLogEvent     SVD_SetUp = 0,SVD_Solve = 0;
     30: static PetscBool  SVDPackageInitialized = PETSC_FALSE;

     34: /*@C
     35:    SVDFinalizePackage - This function destroys everything in the Slepc interface
     36:    to the SVD package. It is called from SlepcFinalize().

     38:    Level: developer

     40: .seealso: SlepcFinalize()
     41: @*/
     42: PetscErrorCode SVDFinalizePackage(void)
     43: {

     47:   PetscFunctionListDestroy(&SVDList);
     48:   SVDPackageInitialized = PETSC_FALSE;
     49:   SVDRegisterAllCalled  = PETSC_FALSE;
     50:   return(0);
     51: }

     55: /*@C
     56:    SVDInitializePackage - This function initializes everything in the SVD package. It is called
     57:    from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to SVDCreate()
     58:    when using static libraries.

     60:    Level: developer

     62: .seealso: SlepcInitialize()
     63: @*/
     64: PetscErrorCode SVDInitializePackage(void)
     65: {
     66:   char           logList[256];
     67:   char           *className;
     68:   PetscBool      opt;

     72:   if (SVDPackageInitialized) return(0);
     73:   SVDPackageInitialized = PETSC_TRUE;
     74:   /* Register Classes */
     75:   PetscClassIdRegister("Singular Value Solver",&SVD_CLASSID);
     76:   /* Register Constructors */
     77:   SVDRegisterAll();
     78:   /* Register Events */
     79:   PetscLogEventRegister("SVDSetUp",SVD_CLASSID,&SVD_SetUp);
     80:   PetscLogEventRegister("SVDSolve",SVD_CLASSID,&SVD_Solve);
     81:   /* Process info exclusions */
     82:   PetscOptionsGetString(NULL,"-info_exclude",logList,256,&opt);
     83:   if (opt) {
     84:     PetscStrstr(logList,"svd",&className);
     85:     if (className) {
     86:       PetscInfoDeactivateClass(SVD_CLASSID);
     87:     }
     88:   }
     89:   /* Process summary exclusions */
     90:   PetscOptionsGetString(NULL,"-log_summary_exclude",logList,256,&opt);
     91:   if (opt) {
     92:     PetscStrstr(logList,"svd",&className);
     93:     if (className) {
     94:       PetscLogEventDeactivateClass(SVD_CLASSID);
     95:     }
     96:   }
     97:   PetscRegisterFinalize(SVDFinalizePackage);
     98:   return(0);
     99: }

    103: /*@C
    104:    SVDView - Prints the SVD data structure.

    106:    Collective on SVD

    108:    Input Parameters:
    109: +  svd - the singular value solver context
    110: -  viewer - optional visualization context

    112:    Options Database Key:
    113: .  -svd_view -  Calls SVDView() at end of SVDSolve()

    115:    Note:
    116:    The available visualization contexts include
    117: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
    118: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
    119:          output where only the first processor opens
    120:          the file.  All other processors send their
    121:          data to the first processor to print.

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

    126:    Level: beginner

    128: .seealso: STView(), PetscViewerASCIIOpen()
    129: @*/
    130: PetscErrorCode SVDView(SVD svd,PetscViewer viewer)
    131: {
    133:   PetscBool      isascii,isshell;

    137:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)svd));

    141:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    142:   if (isascii) {
    143:     PetscObjectPrintClassNamePrefixType((PetscObject)svd,viewer,"SVD Object");
    144:     if (svd->ops->view) {
    145:       PetscViewerASCIIPushTab(viewer);
    146:       (*svd->ops->view)(svd,viewer);
    147:       PetscViewerASCIIPopTab(viewer);
    148:     }
    149:     switch (svd->transmode) {
    150:       case SVD_TRANSPOSE_EXPLICIT:
    151:         PetscViewerASCIIPrintf(viewer,"  transpose mode: explicit\n");
    152:         break;
    153:       case SVD_TRANSPOSE_IMPLICIT:
    154:         PetscViewerASCIIPrintf(viewer,"  transpose mode: implicit\n");
    155:         break;
    156:       default:
    157:         PetscViewerASCIIPrintf(viewer,"  transpose mode: not yet set\n");
    158:     }
    159:     if (svd->which == SVD_LARGEST) {
    160:       PetscViewerASCIIPrintf(viewer,"  selected portion of the spectrum: largest\n");
    161:     } else {
    162:       PetscViewerASCIIPrintf(viewer,"  selected portion of the spectrum: smallest\n");
    163:     }
    164:     PetscViewerASCIIPrintf(viewer,"  number of singular values (nsv): %D\n",svd->nsv);
    165:     PetscViewerASCIIPrintf(viewer,"  number of column vectors (ncv): %D\n",svd->ncv);
    166:     PetscViewerASCIIPrintf(viewer,"  maximum dimension of projected problem (mpd): %D\n",svd->mpd);
    167:     PetscViewerASCIIPrintf(viewer,"  maximum number of iterations: %D\n",svd->max_it);
    168:     PetscViewerASCIIPrintf(viewer,"  tolerance: %G\n",svd->tol);
    169:     if (svd->nini) {
    170:       PetscViewerASCIIPrintf(viewer,"  dimension of user-provided initial space: %D\n",PetscAbs(svd->nini));
    171:     }
    172:     if (svd->ninil) {
    173:       PetscViewerASCIIPrintf(viewer,"  dimension of user-provided initial left space: %D\n",PetscAbs(svd->ninil));
    174:     }
    175:   } else {
    176:     if (svd->ops->view) {
    177:       (*svd->ops->view)(svd,viewer);
    178:     }
    179:   }
    180:   PetscObjectTypeCompareAny((PetscObject)svd,&isshell,SVDCROSS,SVDCYCLIC,"");
    181:   if (!isshell) {
    182:     if (!svd->ip) { SVDGetIP(svd,&svd->ip); }
    183:     IPView(svd->ip,viewer);
    184:     if (!svd->ds) { SVDGetDS(svd,&svd->ds); }
    185:     PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO);
    186:     DSView(svd->ds,viewer);
    187:     PetscViewerPopFormat(viewer);
    188:   }
    189:   return(0);
    190: }

    194: /*@
    195:    SVDPrintSolution - Prints the computed singular values.

    197:    Collective on SVD

    199:    Input Parameters:
    200: +  svd - the singular value solver context
    201: -  viewer - optional visualization context

    203:    Options Database Key:
    204: .  -svd_terse - print only minimal information

    206:    Note:
    207:    By default, this function prints a table with singular values and associated
    208:    relative errors. With -svd_terse only the singular values are printed.

    210:    Level: intermediate

    212: .seealso: PetscViewerASCIIOpen()
    213: @*/
    214: PetscErrorCode SVDPrintSolution(SVD svd,PetscViewer viewer)
    215: {
    216:   PetscBool      terse,errok,isascii;
    217:   PetscReal      error,sigma;
    218:   PetscInt       i,j;

    223:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)svd));
    226:   if (!svd->sigma) SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_WRONGSTATE,"SVDSolve must be called first");
    227:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    228:   if (!isascii) return(0);

    230:   PetscOptionsHasName(NULL,"-svd_terse",&terse);
    231:   if (terse) {
    232:     if (svd->nconv<svd->nsv) {
    233:       PetscViewerASCIIPrintf(viewer," Problem: less than %D singular values converged\n\n",svd->nsv);
    234:     } else {
    235:       errok = PETSC_TRUE;
    236:       for (i=0;i<svd->nsv;i++) {
    237:         SVDComputeRelativeError(svd,i,&error);
    238:         errok = (errok && error<svd->tol)? PETSC_TRUE: PETSC_FALSE;
    239:       }
    240:       if (errok) {
    241:         PetscViewerASCIIPrintf(viewer," All requested singular values computed up to the required tolerance:");
    242:         for (i=0;i<=(svd->nsv-1)/8;i++) {
    243:           PetscViewerASCIIPrintf(viewer,"\n     ");
    244:           for (j=0;j<PetscMin(8,svd->nsv-8*i);j++) {
    245:             SVDGetSingularTriplet(svd,8*i+j,&sigma,NULL,NULL);
    246:             PetscViewerASCIIPrintf(viewer,"%.5F",sigma);
    247:             if (8*i+j+1<svd->nsv) { PetscViewerASCIIPrintf(viewer,", "); }
    248:           }
    249:         }
    250:         PetscViewerASCIIPrintf(viewer,"\n\n");
    251:       } else {
    252:         PetscViewerASCIIPrintf(viewer," Problem: some of the first %D relative errors are higher than the tolerance\n\n",svd->nsv);
    253:       }
    254:     }
    255:   } else {
    256:     PetscViewerASCIIPrintf(viewer," Number of converged approximate singular triplets: %D\n\n",svd->nconv);
    257:     if (svd->nconv>0) {
    258:       PetscViewerASCIIPrintf(viewer,
    259:            "          sigma            relative error\n"
    260:            "   --------------------- ------------------\n");
    261:       for (i=0;i<svd->nconv;i++) {
    262:         SVDGetSingularTriplet(svd,i,&sigma,NULL,NULL);
    263:         SVDComputeRelativeError(svd,i,&error);
    264:         PetscViewerASCIIPrintf(viewer,"       % 6F          %12G\n",sigma,error);
    265:       }
    266:       PetscViewerASCIIPrintf(viewer,"\n");
    267:     }
    268:   }
    269:   return(0);
    270: }

    274: /*@C
    275:    SVDCreate - Creates the default SVD context.

    277:    Collective on MPI_Comm

    279:    Input Parameter:
    280: .  comm - MPI communicator

    282:    Output Parameter:
    283: .  svd - location to put the SVD context

    285:    Note:
    286:    The default SVD type is SVDCROSS

    288:    Level: beginner

    290: .seealso: SVDSetUp(), SVDSolve(), SVDDestroy(), SVD
    291: @*/
    292: PetscErrorCode SVDCreate(MPI_Comm comm,SVD *outsvd)
    293: {
    295:   SVD            svd;

    299:   *outsvd = 0;
    300: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
    301:   SVDInitializePackage();
    302: #endif

    304:   SlepcHeaderCreate(svd,_p_SVD,struct _SVDOps,SVD_CLASSID,"SVD","Singular Value Decomposition","SVD",comm,SVDDestroy,SVDView);

    306:   svd->OP             = NULL;
    307:   svd->ip             = NULL;
    308:   svd->ds             = NULL;
    309:   svd->A              = NULL;
    310:   svd->AT             = NULL;
    311:   svd->transmode      = (SVDTransposeMode)PETSC_DECIDE;
    312:   svd->sigma          = NULL;
    313:   svd->perm           = NULL;
    314:   svd->U              = NULL;
    315:   svd->V              = NULL;
    316:   svd->IS             = NULL;
    317:   svd->ISL            = NULL;
    318:   svd->tl             = NULL;
    319:   svd->tr             = NULL;
    320:   svd->rand           = NULL;
    321:   svd->which          = SVD_LARGEST;
    322:   svd->n              = 0;
    323:   svd->nconv          = 0;
    324:   svd->nsv            = 1;
    325:   svd->ncv            = 0;
    326:   svd->mpd            = 0;
    327:   svd->nini           = 0;
    328:   svd->ninil          = 0;
    329:   svd->its            = 0;
    330:   svd->max_it         = 0;
    331:   svd->tol            = PETSC_DEFAULT;
    332:   svd->errest         = NULL;
    333:   svd->data           = NULL;
    334:   svd->setupcalled    = 0;
    335:   svd->reason         = SVD_CONVERGED_ITERATING;
    336:   svd->numbermonitors = 0;
    337:   svd->matvecs        = 0;
    338:   svd->trackall       = PETSC_FALSE;

    340:   PetscRandomCreate(comm,&svd->rand);
    341:   PetscRandomSetSeed(svd->rand,0x12345678);
    342:   PetscLogObjectParent(svd,svd->rand);
    343:   *outsvd = svd;
    344:   return(0);
    345: }

    349: /*@
    350:    SVDReset - Resets the SVD context to the setupcalled=0 state and removes any
    351:    allocated objects.

    353:    Collective on SVD

    355:    Input Parameter:
    356: .  svd - singular value solver context obtained from SVDCreate()

    358:    Level: advanced

    360: .seealso: SVDDestroy()
    361: @*/
    362: PetscErrorCode SVDReset(SVD svd)
    363: {

    368:   if (svd->ops->reset) { (svd->ops->reset)(svd); }
    369:   if (svd->ip) { IPReset(svd->ip); }
    370:   if (svd->ds) { DSReset(svd->ds); }
    371:   MatDestroy(&svd->OP);
    372:   MatDestroy(&svd->A);
    373:   MatDestroy(&svd->AT);
    374:   VecDestroy(&svd->tl);
    375:   VecDestroy(&svd->tr);
    376:   if (svd->n) {
    377:     PetscFree(svd->sigma);
    378:     PetscFree(svd->perm);
    379:     PetscFree(svd->errest);
    380:     VecDestroyVecs(svd->n,&svd->U);
    381:     VecDestroyVecs(svd->n,&svd->V);
    382:   }
    383:   svd->transmode   = (SVDTransposeMode)PETSC_DECIDE;
    384:   svd->matvecs     = 0;
    385:   svd->setupcalled = 0;
    386:   return(0);
    387: }

    391: /*@C
    392:    SVDDestroy - Destroys the SVD context.

    394:    Collective on SVD

    396:    Input Parameter:
    397: .  svd - singular value solver context obtained from SVDCreate()

    399:    Level: beginner

    401: .seealso: SVDCreate(), SVDSetUp(), SVDSolve()
    402: @*/
    403: PetscErrorCode SVDDestroy(SVD *svd)
    404: {

    408:   if (!*svd) return(0);
    410:   if (--((PetscObject)(*svd))->refct > 0) { *svd = 0; return(0); }
    411:   SVDReset(*svd);
    412:   if ((*svd)->ops->destroy) { (*(*svd)->ops->destroy)(*svd); }
    413:   IPDestroy(&(*svd)->ip);
    414:   DSDestroy(&(*svd)->ds);
    415:   /* just in case the initial vectors have not been used */
    416:   SlepcBasisDestroy_Private(&(*svd)->nini,&(*svd)->IS);
    417:   SlepcBasisDestroy_Private(&(*svd)->ninil,&(*svd)->ISL);
    418:   PetscRandomDestroy(&(*svd)->rand);
    419:   SVDMonitorCancel(*svd);
    420:   PetscHeaderDestroy(svd);
    421:   return(0);
    422: }

    426: /*@C
    427:    SVDSetType - Selects the particular solver to be used in the SVD object.

    429:    Logically Collective on SVD

    431:    Input Parameters:
    432: +  svd      - the singular value solver context
    433: -  type     - a known method

    435:    Options Database Key:
    436: .  -svd_type <method> - Sets the method; use -help for a list
    437:     of available methods

    439:    Notes:
    440:    See "slepc/include/slepcsvd.h" for available methods. The default
    441:    is SVDCROSS.

    443:    Normally, it is best to use the SVDSetFromOptions() command and
    444:    then set the SVD type from the options database rather than by using
    445:    this routine.  Using the options database provides the user with
    446:    maximum flexibility in evaluating the different available methods.
    447:    The SVDSetType() routine is provided for those situations where it
    448:    is necessary to set the iterative solver independently of the command
    449:    line or options database.

    451:    Level: intermediate

    453: .seealso: SVDType
    454: @*/
    455: PetscErrorCode SVDSetType(SVD svd,SVDType type)
    456: {
    457:   PetscErrorCode ierr,(*r)(SVD);
    458:   PetscBool      match;

    464:   PetscObjectTypeCompare((PetscObject)svd,type,&match);
    465:   if (match) return(0);

    467:   PetscFunctionListFind(SVDList,type,&r);
    468:   if (!r) SETERRQ1(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown SVD type given: %s",type);

    470:   if (svd->ops->destroy) { (*svd->ops->destroy)(svd); }
    471:   PetscMemzero(svd->ops,sizeof(struct _SVDOps));

    473:   svd->setupcalled = 0;
    474:   PetscObjectChangeTypeName((PetscObject)svd,type);
    475:   (*r)(svd);
    476:   return(0);
    477: }

    481: /*@C
    482:    SVDGetType - Gets the SVD type as a string from the SVD object.

    484:    Not Collective

    486:    Input Parameter:
    487: .  svd - the singular value solver context

    489:    Output Parameter:
    490: .  name - name of SVD method

    492:    Level: intermediate

    494: .seealso: SVDSetType()
    495: @*/
    496: PetscErrorCode SVDGetType(SVD svd,SVDType *type)
    497: {
    501:   *type = ((PetscObject)svd)->type_name;
    502:   return(0);
    503: }

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

    510:    Not Collective

    512:    Input Parameters:
    513: +  name - name of a new user-defined solver
    514: -  function - routine to create the solver context

    516:    Notes:
    517:    SVDRegister() may be called multiple times to add several user-defined solvers.

    519:    Sample usage:
    520: .vb
    521:    SVDRegister("my_solver",MySolverCreate);
    522: .ve

    524:    Then, your solver can be chosen with the procedural interface via
    525: $     SVDSetType(svd,"my_solver")
    526:    or at runtime via the option
    527: $     -svd_type my_solver

    529:    Level: advanced

    531: .seealso: SVDRegisterAll()
    532: @*/
    533: PetscErrorCode SVDRegister(const char *name,PetscErrorCode (*function)(SVD))
    534: {

    538:   PetscFunctionListAdd(&SVDList,name,function);
    539:   return(0);
    540: }

    544: /*@
    545:    SVDSetIP - Associates an inner product object to the
    546:    singular value solver.

    548:    Collective on SVD

    550:    Input Parameters:
    551: +  svd - singular value solver context obtained from SVDCreate()
    552: -  ip  - the inner product object

    554:    Note:
    555:    Use SVDGetIP() to retrieve the inner product context (for example,
    556:    to free it at the end of the computations).

    558:    Level: advanced

    560: .seealso: SVDGetIP()
    561: @*/
    562: PetscErrorCode SVDSetIP(SVD svd,IP ip)
    563: {

    570:   PetscObjectReference((PetscObject)ip);
    571:   IPDestroy(&svd->ip);
    572:   svd->ip = ip;
    573:   PetscLogObjectParent(svd,svd->ip);
    574:   return(0);
    575: }

    579: /*@C
    580:    SVDGetIP - Obtain the inner product object associated
    581:    to the singular value solver object.

    583:    Not Collective

    585:    Input Parameters:
    586: .  svd - singular value solver context obtained from SVDCreate()

    588:    Output Parameter:
    589: .  ip - inner product context

    591:    Level: advanced

    593: .seealso: SVDSetIP()
    594: @*/
    595: PetscErrorCode SVDGetIP(SVD svd,IP *ip)
    596: {

    602:   if (!svd->ip) {
    603:     IPCreate(PetscObjectComm((PetscObject)svd),&svd->ip);
    604:     PetscLogObjectParent(svd,svd->ip);
    605:   }
    606:   *ip = svd->ip;
    607:   return(0);
    608: }

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

    615:    Collective on SVD

    617:    Input Parameters:
    618: +  svd - singular value solver context obtained from SVDCreate()
    619: -  ds  - the direct solver object

    621:    Note:
    622:    Use SVDGetDS() to retrieve the direct solver context (for example,
    623:    to free it at the end of the computations).

    625:    Level: advanced

    627: .seealso: SVDGetDS()
    628: @*/
    629: PetscErrorCode SVDSetDS(SVD svd,DS ds)
    630: {

    637:   PetscObjectReference((PetscObject)ds);
    638:   DSDestroy(&svd->ds);
    639:   svd->ds = ds;
    640:   PetscLogObjectParent(svd,svd->ds);
    641:   return(0);
    642: }

    646: /*@C
    647:    SVDGetDS - Obtain the direct solver object associated to the singular value
    648:    solver object.

    650:    Not Collective

    652:    Input Parameters:
    653: .  svd - singular value solver context obtained from SVDCreate()

    655:    Output Parameter:
    656: .  ds - direct solver context

    658:    Level: advanced

    660: .seealso: SVDSetDS()
    661: @*/
    662: PetscErrorCode SVDGetDS(SVD svd,DS *ds)
    663: {

    669:   if (!svd->ds) {
    670:     DSCreate(PetscObjectComm((PetscObject)svd),&svd->ds);
    671:     PetscLogObjectParent(svd,svd->ds);
    672:   }
    673:   *ds = svd->ds;
    674:   return(0);
    675: }