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

Actual source code: gklanczos.c

      1: /*

      3:    SLEPc singular value solver: "lanczos"

      5:    Method: Explicitly restarted Lanczos

      7:    Algorithm:

      9:        Golub-Kahan-Lanczos bidiagonalization with explicit restart.

     11:    References:

     13:        [1] G.H. Golub and W. Kahan, "Calculating the singular values
     14:            and pseudo-inverse of a matrix", SIAM J. Numer. Anal. Ser.
     15:            B 2:205-224, 1965.

     17:        [2] V. Hernandez, J.E. Roman, and A. Tomas, "A robust and
     18:            efficient parallel SVD solver based on restarted Lanczos
     19:            bidiagonalization", Elec. Trans. Numer. Anal. 31:68-85,
     20:            2008.

     22:    Last update: Jun 2007

     24:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     25:    SLEPc - Scalable Library for Eigenvalue Problem Computations
     26:    Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain

     28:    This file is part of SLEPc.

     30:    SLEPc is free software: you can redistribute it and/or modify it under  the
     31:    terms of version 3 of the GNU Lesser General Public License as published by
     32:    the Free Software Foundation.

     34:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     35:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     36:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     37:    more details.

     39:    You  should have received a copy of the GNU Lesser General  Public  License
     40:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     41:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     42: */

     44: #include <slepc-private/svdimpl.h>                /*I "slepcsvd.h" I*/
     45: #include <slepc-private/ipimpl.h>
     46: #include <slepcblaslapack.h>

     48: typedef struct {
     49:   PetscBool oneside;
     50: } SVD_LANCZOS;

     54: PetscErrorCode SVDSetUp_Lanczos(SVD svd)
     55: {
     57:   SVD_LANCZOS    *lanczos = (SVD_LANCZOS*)svd->data;
     58:   PetscInt       N;

     61:   SVDMatGetSize(svd,NULL,&N);
     62:   if (svd->ncv) { /* ncv set */
     63:     if (svd->ncv<svd->nsv) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The value of ncv must be at least nsv");
     64:   } else if (svd->mpd) { /* mpd set */
     65:     svd->ncv = PetscMin(N,svd->nsv+svd->mpd);
     66:   } else { /* neither set: defaults depend on nsv being small or large */
     67:     if (svd->nsv<500) svd->ncv = PetscMin(N,PetscMax(2*svd->nsv,10));
     68:     else {
     69:       svd->mpd = 500;
     70:       svd->ncv = PetscMin(N,svd->nsv+svd->mpd);
     71:     }
     72:   }
     73:   if (!svd->mpd) svd->mpd = svd->ncv;
     74:   if (svd->ncv>svd->nsv+svd->mpd) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The value of ncv must not be larger than nev+mpd");
     75:   if (!svd->max_it) svd->max_it = PetscMax(N/svd->ncv,100);
     76:   if (!lanczos->oneside && svd->ncv != svd->n) {
     77:     VecDestroyVecs(svd->n,&svd->U);
     78:     VecDuplicateVecs(svd->tl,svd->ncv,&svd->U);
     79:     PetscLogObjectParents(svd,svd->ncv,svd->U);
     80:   }
     81:   DSSetType(svd->ds,DSSVD);
     82:   DSSetCompact(svd->ds,PETSC_TRUE);
     83:   DSAllocate(svd->ds,svd->ncv);
     84:   return(0);
     85: }

     89: PetscErrorCode SVDTwoSideLanczos(SVD svd,PetscReal *alpha,PetscReal *beta,Vec *V,Vec v,Vec *U,PetscInt k,PetscInt n,PetscScalar* work)
     90: {
     92:   PetscInt       i;

     95:   SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);
     96:   IPOrthogonalize(svd->ip,0,NULL,k,NULL,U,U[k],work,alpha+k,NULL);
     97:   VecScale(U[k],1.0/alpha[k]);
     98:   for (i=k+1;i<n;i++) {
     99:     SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);
    100:     IPOrthogonalize(svd->ip,0,NULL,i,NULL,V,V[i],work,beta+i-1,NULL);
    101:     VecScale(V[i],1.0/beta[i-1]);

    103:     SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);
    104:     IPOrthogonalize(svd->ip,0,NULL,i,NULL,U,U[i],work,alpha+i,NULL);
    105:     VecScale(U[i],1.0/alpha[i]);
    106:   }
    107:   SVDMatMult(svd,PETSC_TRUE,U[n-1],v);
    108:   IPOrthogonalize(svd->ip,0,NULL,n,NULL,V,v,work,beta+n-1,NULL);
    109:   return(0);
    110: }

    114: static PetscErrorCode SVDOneSideLanczos(SVD svd,PetscReal *alpha,PetscReal *beta,Vec *V,Vec v,Vec u,Vec u_1,PetscInt k,PetscInt n,PetscScalar* work)
    115: {
    117:   PetscInt       i;
    118:   PetscReal      a,b;
    119:   Vec            temp;

    122:   SVDMatMult(svd,PETSC_FALSE,V[k],u);
    123:   for (i=k+1;i<n;i++) {
    124:     SVDMatMult(svd,PETSC_TRUE,u,V[i]);
    125:     IPNormBegin(svd->ip,u,&a);
    126:     IPMInnerProductBegin(svd->ip,V[i],i,V,work);
    127:     IPNormEnd(svd->ip,u,&a);
    128:     IPMInnerProductEnd(svd->ip,V[i],i,V,work);

    130:     VecScale(u,1.0/a);
    131:     SlepcVecMAXPBY(V[i],1.0/a,-1.0/a,i,work,V);

    133:     IPOrthogonalizeCGS1(svd->ip,0,NULL,i,NULL,V,V[i],work,NULL,&b);
    134:     VecScale(V[i],1.0/b);

    136:     SVDMatMult(svd,PETSC_FALSE,V[i],u_1);
    137:     VecAXPY(u_1,-b,u);

    139:     alpha[i-1] = a;
    140:     beta[i-1] = b;
    141:     temp = u;
    142:     u = u_1;
    143:     u_1 = temp;
    144:   }
    145:   SVDMatMult(svd,PETSC_TRUE,u,v);
    146:   IPNormBegin(svd->ip,u,&a);
    147:   IPMInnerProductBegin(svd->ip,v,n,V,work);
    148:   IPNormEnd(svd->ip,u,&a);
    149:   IPMInnerProductEnd(svd->ip,v,n,V,work);

    151:   VecScale(u,1.0/a);
    152:   SlepcVecMAXPBY(v,1.0/a,-1.0/a,n,work,V);

    154:   IPOrthogonalizeCGS1(svd->ip,0,NULL,n,NULL,V,v,work,NULL,&b);

    156:   alpha[n-1] = a;
    157:   beta[n-1] = b;
    158:   return(0);
    159: }

    163: PetscErrorCode SVDSolve_Lanczos(SVD svd)
    164: {
    166:   SVD_LANCZOS    *lanczos = (SVD_LANCZOS*)svd->data;
    167:   PetscReal      *alpha,*beta,lastbeta;
    168:   PetscScalar    *swork,*w,*Q,*PT;
    169:   PetscInt       i,k,j,nv,ld,off;
    170:   Vec            v,u=0,u_1=0;
    171:   PetscBool      conv;

    174:   /* allocate working space */
    175:   DSGetLeadingDimension(svd->ds,&ld);
    176:   PetscMalloc(sizeof(PetscScalar)*ld,&w);
    177:   PetscMalloc(sizeof(PetscScalar)*svd->n,&swork);

    179:   VecDuplicate(svd->V[0],&v);
    180:   if (lanczos->oneside) {
    181:     SVDMatGetVecs(svd,NULL,&u);
    182:     SVDMatGetVecs(svd,NULL,&u_1);
    183:   }

    185:   /* normalize start vector */
    186:   if (!svd->nini) {
    187:     SlepcVecSetRandom(svd->V[0],svd->rand);
    188:   }
    189:   VecNormalize(svd->V[0],NULL);

    191:   while (svd->reason == SVD_CONVERGED_ITERATING) {
    192:     svd->its++;

    194:     /* inner loop */
    195:     nv = PetscMin(svd->nconv+svd->mpd,svd->n);
    196:     DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
    197:     beta = alpha + ld;
    198:     if (lanczos->oneside) {
    199:       SVDOneSideLanczos(svd,alpha,beta,svd->V,v,u,u_1,svd->nconv,nv,swork);
    200:     } else {
    201:       SVDTwoSideLanczos(svd,alpha,beta,svd->V,v,svd->U,svd->nconv,nv,swork);
    202:     }
    203:     lastbeta = beta[nv-1];
    204:     DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);

    206:     /* compute SVD of bidiagonal matrix */
    207:     DSSetDimensions(svd->ds,nv,nv,svd->nconv,0);
    208:     DSSetState(svd->ds,DS_STATE_INTERMEDIATE);
    209:     DSSolve(svd->ds,w,NULL);
    210:     DSSort(svd->ds,w,NULL,NULL,NULL,NULL);

    212:     /* compute error estimates */
    213:     k = 0;
    214:     conv = PETSC_TRUE;
    215:     DSGetArray(svd->ds,DS_MAT_U,&Q);
    216:     for (i=svd->nconv;i<nv;i++) {
    217:       svd->sigma[i] = PetscRealPart(w[i]);
    218:       svd->errest[i] = PetscAbsScalar(Q[nv-1+i*ld])*lastbeta;
    219:       if (svd->sigma[i] > svd->tol) svd->errest[i] /= svd->sigma[i];
    220:       if (conv) {
    221:         if (svd->errest[i] < svd->tol) k++;
    222:         else conv = PETSC_FALSE;
    223:       }
    224:     }

    226:     /* check convergence */
    227:     if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
    228:     if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;

    230:     /* compute restart vector */
    231:     DSGetArray(svd->ds,DS_MAT_VT,&PT);
    232:     if (svd->reason == SVD_CONVERGED_ITERATING) {
    233:       for (j=svd->nconv;j<nv;j++) swork[j-svd->nconv] = PT[k+svd->nconv+j*ld];
    234:       SlepcVecMAXPBY(v,0.0,1.0,nv-svd->nconv,swork,svd->V+svd->nconv);
    235:     }

    237:     /* compute converged singular vectors */
    238:     off = svd->nconv+svd->nconv*ld;
    239:     SlepcUpdateVectors(nv-svd->nconv,svd->V+svd->nconv,0,k,PT+off,ld,PETSC_TRUE);
    240:     if (!lanczos->oneside) {
    241:       SlepcUpdateVectors(nv-svd->nconv,svd->U+svd->nconv,0,k,Q+off,ld,PETSC_FALSE);
    242:     }
    243:     DSRestoreArray(svd->ds,DS_MAT_VT,&PT);
    244:     DSRestoreArray(svd->ds,DS_MAT_U,&Q);

    246:     /* copy restart vector from temporary space */
    247:     if (svd->reason == SVD_CONVERGED_ITERATING) {
    248:       VecCopy(v,svd->V[svd->nconv+k]);
    249:     }

    251:     svd->nconv += k;
    252:     SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
    253:   }

    255:   /* free working space */
    256:   VecDestroy(&v);
    257:   VecDestroy(&u);
    258:   VecDestroy(&u_1);
    259:   PetscFree(w);
    260:   PetscFree(swork);
    261:   return(0);
    262: }

    266: PetscErrorCode SVDSetFromOptions_Lanczos(SVD svd)
    267: {
    269:   PetscBool      set,val;
    270:   SVD_LANCZOS    *lanczos = (SVD_LANCZOS*)svd->data;

    273:   PetscOptionsHead("SVD Lanczos Options");
    274:   PetscOptionsBool("-svd_lanczos_oneside","Lanczos one-side reorthogonalization","SVDLanczosSetOneSide",lanczos->oneside,&val,&set);
    275:   if (set) {
    276:     SVDLanczosSetOneSide(svd,val);
    277:   }
    278:   PetscOptionsTail();
    279:   return(0);
    280: }

    284: static PetscErrorCode SVDLanczosSetOneSide_Lanczos(SVD svd,PetscBool oneside)
    285: {
    286:   SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;

    289:   if (lanczos->oneside != oneside) {
    290:     lanczos->oneside = oneside;
    291:     svd->setupcalled = 0;
    292:   }
    293:   return(0);
    294: }

    298: /*@
    299:    SVDLanczosSetOneSide - Indicate if the variant of the Lanczos method
    300:    to be used is one-sided or two-sided.

    302:    Logically Collective on SVD

    304:    Input Parameters:
    305: +  svd     - singular value solver
    306: -  oneside - boolean flag indicating if the method is one-sided or not

    308:    Options Database Key:
    309: .  -svd_lanczos_oneside <boolean> - Indicates the boolean flag

    311:    Note:
    312:    By default, a two-sided variant is selected, which is sometimes slightly
    313:    more robust. However, the one-sided variant is faster because it avoids
    314:    the orthogonalization associated to left singular vectors. It also saves
    315:    the memory required for storing such vectors.

    317:    Level: advanced

    319: .seealso: SVDTRLanczosSetOneSide()
    320: @*/
    321: PetscErrorCode SVDLanczosSetOneSide(SVD svd,PetscBool oneside)
    322: {

    328:   PetscTryMethod(svd,"SVDLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
    329:   return(0);
    330: }

    334: /*@
    335:    SVDLanczosGetOneSide - Gets if the variant of the Lanczos method
    336:    to be used is one-sided or two-sided.

    338:    Not Collective

    340:    Input Parameters:
    341: .  svd     - singular value solver

    343:    Output Parameters:
    344: .  oneside - boolean flag indicating if the method is one-sided or not

    346:    Level: advanced

    348: .seealso: SVDLanczosSetOneSide()
    349: @*/
    350: PetscErrorCode SVDLanczosGetOneSide(SVD svd,PetscBool *oneside)
    351: {

    357:   PetscTryMethod(svd,"SVDLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
    358:   return(0);
    359: }

    363: static PetscErrorCode SVDLanczosGetOneSide_Lanczos(SVD svd,PetscBool *oneside)
    364: {
    365:   SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;

    368:   *oneside = lanczos->oneside;
    369:   return(0);
    370: }

    374: PetscErrorCode SVDReset_Lanczos(SVD svd)
    375: {

    379:   VecDestroyVecs(svd->n,&svd->U);
    380:   return(0);
    381: }

    385: PetscErrorCode SVDDestroy_Lanczos(SVD svd)
    386: {

    390:   PetscFree(svd->data);
    391:   PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosSetOneSide_C",NULL);
    392:   PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosGetOneSide_C",NULL);
    393:   return(0);
    394: }

    398: PetscErrorCode SVDView_Lanczos(SVD svd,PetscViewer viewer)
    399: {
    401:   SVD_LANCZOS    *lanczos = (SVD_LANCZOS*)svd->data;

    404:   PetscViewerASCIIPrintf(viewer,"  Lanczos: %s-sided reorthogonalization\n",lanczos->oneside? "one": "two");
    405:   return(0);
    406: }

    410: PETSC_EXTERN PetscErrorCode SVDCreate_Lanczos(SVD svd)
    411: {

    415:   PetscNewLog(svd,SVD_LANCZOS,&svd->data);
    416:   svd->ops->setup          = SVDSetUp_Lanczos;
    417:   svd->ops->solve          = SVDSolve_Lanczos;
    418:   svd->ops->destroy        = SVDDestroy_Lanczos;
    419:   svd->ops->reset          = SVDReset_Lanczos;
    420:   svd->ops->setfromoptions = SVDSetFromOptions_Lanczos;
    421:   svd->ops->view           = SVDView_Lanczos;
    422:   PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosSetOneSide_C",SVDLanczosSetOneSide_Lanczos);
    423:   PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosGetOneSide_C",SVDLanczosGetOneSide_Lanczos);
    424:   return(0);
    425: }