Date: 2016-09-29T11:12:14+00:00

Actual source code: trlanczos.c
slepc-3.7.3 2016-09-29
Report Typos and Errors

      1: /*

      3:    SLEPc singular value solver: "trlanczos"

      5:    Method: Thick-restart Lanczos

      7:    Algorithm:

      9:        Golub-Kahan-Lanczos bidiagonalization with thick-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:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     23:    SLEPc - Scalable Library for Eigenvalue Problem Computations
     24:    Copyright (c) 2002-2016, Universitat Politecnica de Valencia, Spain

     26:    This file is part of SLEPc.

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

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

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

     42: #include <slepc/private/svdimpl.h>          /*I "slepcsvd.h" I*/

     44: static PetscBool  cited = PETSC_FALSE;
     45: static const char citation[] =
     46:   "@Article{slepc-svd,\n"
     47:   "   author = \"V. Hern{\\'a}ndez and J. E. Rom{\\'a}n and A. Tom{\\'a}s\",\n"
     48:   "   title = \"A robust and efficient parallel {SVD} solver based on restarted {Lanczos} bidiagonalization\",\n"
     49:   "   journal = \"Electron. Trans. Numer. Anal.\",\n"
     50:   "   volume = \"31\",\n"
     51:   "   pages = \"68--85\",\n"
     52:   "   year = \"2008\"\n"
     53:   "}\n";

     55: typedef struct {
     56:   PetscBool oneside;
     57: } SVD_TRLANCZOS;

     61: PetscErrorCode SVDSetUp_TRLanczos(SVD svd)
     62: {
     64:   PetscInt       N;

     67:   SVDMatGetSize(svd,NULL,&N);
     68:   SVDSetDimensions_Default(svd);
     69:   if (svd->ncv>svd->nsv+svd->mpd) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The value of ncv must not be larger than nev+mpd");
     70:   if (!svd->max_it) svd->max_it = PetscMax(N/svd->ncv,100);
     71:   svd->leftbasis = PETSC_TRUE;
     72:   SVDAllocateSolution(svd,1);
     73:   DSSetType(svd->ds,DSSVD);
     74:   DSSetCompact(svd->ds,PETSC_TRUE);
     75:   DSAllocate(svd->ds,svd->ncv);
     76:   return(0);
     77: }

     81: static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
     82: {
     84:   PetscReal      a,b;
     85:   PetscInt       i,k=nconv+l;
     86:   Vec            ui,ui1,vi;

     89:   BVGetColumn(V,k,&vi);
     90:   BVGetColumn(U,k,&ui);
     91:   SVDMatMult(svd,PETSC_FALSE,vi,ui);
     92:   BVRestoreColumn(V,k,&vi);
     93:   BVRestoreColumn(U,k,&ui);
     94:   if (l>0) {
     95:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
     96:     BVMultColumn(U,-1.0,1.0,k,work);
     97:   }
     98:   BVNormColumn(U,k,NORM_2,&a);
     99:   BVScaleColumn(U,k,1.0/a);
    100:   alpha[k] = a;

    102:   for (i=k+1;i<n;i++) {
    103:     BVGetColumn(V,i,&vi);
    104:     BVGetColumn(U,i-1,&ui1);
    105:     SVDMatMult(svd,PETSC_TRUE,ui1,vi);
    106:     BVRestoreColumn(V,i,&vi);
    107:     BVRestoreColumn(U,i-1,&ui1);
    108:     BVOrthogonalizeColumn(V,i,NULL,&b,NULL);
    109:     BVScaleColumn(V,i,1.0/b);
    110:     beta[i-1] = b;

    112:     BVGetColumn(V,i,&vi);
    113:     BVGetColumn(U,i,&ui);
    114:     SVDMatMult(svd,PETSC_FALSE,vi,ui);
    115:     BVRestoreColumn(V,i,&vi);
    116:     BVGetColumn(U,i-1,&ui1);
    117:     VecAXPY(ui,-b,ui1);
    118:     BVRestoreColumn(U,i-1,&ui1);
    119:     BVRestoreColumn(U,i,&ui);
    120:     BVNormColumn(U,i,NORM_2,&a);
    121:     BVScaleColumn(U,i,1.0/a);
    122:     alpha[i] = a;
    123:   }

    125:   BVGetColumn(V,n,&vi);
    126:   BVGetColumn(U,n-1,&ui1);
    127:   SVDMatMult(svd,PETSC_TRUE,ui1,vi);
    128:   BVRestoreColumn(V,n,&vi);
    129:   BVRestoreColumn(U,n-1,&ui1);
    130:   BVOrthogonalizeColumn(V,n,NULL,&b,NULL);
    131:   beta[n-1] = b;
    132:   return(0);
    133: }

    137: /*
    138:   Custom CGS orthogonalization, preprocess after first orthogonalization
    139: */
    140: static PetscErrorCode SVDOrthogonalizeCGS(BV V,PetscInt i,PetscScalar* h,PetscReal a,BVOrthogRefineType refine,PetscReal eta,PetscReal *norm)
    141: {
    143:   PetscReal      sum,onorm;
    144:   PetscScalar    dot;
    145:   PetscInt       j;

    148:   switch (refine) {
    149:   case BV_ORTHOG_REFINE_NEVER:
    150:     BVNormColumn(V,i,NORM_2,norm);
    151:     break;
    152:   case BV_ORTHOG_REFINE_ALWAYS:
    153:     BVSetActiveColumns(V,0,i);
    154:     BVDotColumn(V,i,h);
    155:     BVMultColumn(V,-1.0,1.0,i,h);
    156:     BVNormColumn(V,i,NORM_2,norm);
    157:     break;
    158:   case BV_ORTHOG_REFINE_IFNEEDED:
    159:     dot = h[i];
    160:     onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
    161:     sum = 0.0;
    162:     for (j=0;j<i;j++) {
    163:       sum += PetscRealPart(h[j] * PetscConj(h[j]));
    164:     }
    165:     *norm = PetscRealPart(dot)/(a*a) - sum;
    166:     if (*norm>0.0) *norm = PetscSqrtReal(*norm);
    167:     else {
    168:       BVNormColumn(V,i,NORM_2,norm);
    169:     }
    170:     if (*norm < eta*onorm) {
    171:       BVSetActiveColumns(V,0,i);
    172:       BVDotColumn(V,i,h);
    173:       BVMultColumn(V,-1.0,1.0,i,h);
    174:       BVNormColumn(V,i,NORM_2,norm);
    175:     }
    176:     break;
    177:   }
    178:   return(0);
    179: }

    183: static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
    184: {
    185:   PetscErrorCode     ierr;
    186:   PetscReal          a,b,eta;
    187:   PetscInt           i,j,k=nconv+l;
    188:   Vec                ui,ui1,vi;
    189:   BVOrthogRefineType refine;

    192:   BVGetColumn(V,k,&vi);
    193:   BVGetColumn(U,k,&ui);
    194:   SVDMatMult(svd,PETSC_FALSE,vi,ui);
    195:   BVRestoreColumn(V,k,&vi);
    196:   BVRestoreColumn(U,k,&ui);
    197:   if (l>0) {
    198:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
    199:     BVMultColumn(U,-1.0,1.0,k,work);
    200:   }
    201:   BVGetOrthogonalization(V,NULL,&refine,&eta,NULL);

    203:   for (i=k+1;i<n;i++) {
    204:     BVGetColumn(V,i,&vi);
    205:     BVGetColumn(U,i-1,&ui1);
    206:     SVDMatMult(svd,PETSC_TRUE,ui1,vi);
    207:     BVRestoreColumn(V,i,&vi);
    208:     BVRestoreColumn(U,i-1,&ui1);
    209:     BVNormColumnBegin(U,i-1,NORM_2,&a);
    210:     if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
    211:       BVSetActiveColumns(V,0,i+1);
    212:       BVGetColumn(V,i,&vi);
    213:       BVDotVecBegin(V,vi,work);
    214:     } else {
    215:       BVSetActiveColumns(V,0,i);
    216:       BVDotColumnBegin(V,i,work);
    217:     }
    218:     BVNormColumnEnd(U,i-1,NORM_2,&a);
    219:     if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
    220:       BVDotVecEnd(V,vi,work);
    221:       BVRestoreColumn(V,i,&vi);
    222:       BVSetActiveColumns(V,0,i);
    223:     } else {
    224:       BVDotColumnEnd(V,i,work);
    225:     }

    227:     BVScaleColumn(U,i-1,1.0/a);
    228:     for (j=0;j<i;j++) work[j] = work[j] / a;
    229:     BVMultColumn(V,-1.0,1.0/a,i,work);
    230:     SVDOrthogonalizeCGS(V,i,work,a,refine,eta,&b);
    231:     BVScaleColumn(V,i,1.0/b);
    232:     if (PetscAbsReal(b)<10*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Recurrence generated a zero vector; use a two-sided variant");

    234:     BVGetColumn(V,i,&vi);
    235:     BVGetColumn(U,i,&ui);
    236:     BVGetColumn(U,i-1,&ui1);
    237:     SVDMatMult(svd,PETSC_FALSE,vi,ui);
    238:     VecAXPY(ui,-b,ui1);
    239:     BVRestoreColumn(V,i,&vi);
    240:     BVRestoreColumn(U,i,&ui);
    241:     BVRestoreColumn(U,i-1,&ui1);

    243:     alpha[i-1] = a;
    244:     beta[i-1] = b;
    245:   }

    247:   BVGetColumn(V,n,&vi);
    248:   BVGetColumn(U,n-1,&ui1);
    249:   SVDMatMult(svd,PETSC_TRUE,ui1,vi);
    250:   BVRestoreColumn(V,n,&vi);
    251:   BVRestoreColumn(U,n-1,&ui1);

    253:   BVNormColumnBegin(svd->U,n-1,NORM_2,&a);
    254:   if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
    255:     BVSetActiveColumns(V,0,n+1);
    256:     BVGetColumn(V,n,&vi);
    257:     BVDotVecBegin(V,vi,work);
    258:   } else {
    259:     BVSetActiveColumns(V,0,n);
    260:     BVDotColumnBegin(V,n,work);
    261:   }
    262:   BVNormColumnEnd(svd->U,n-1,NORM_2,&a);
    263:   if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
    264:     BVDotVecEnd(V,vi,work);
    265:     BVRestoreColumn(V,n,&vi);
    266:   } else {
    267:     BVDotColumnEnd(V,n,work);
    268:   }

    270:   BVScaleColumn(U,n-1,1.0/a);
    271:   for (j=0;j<n;j++) work[j] = work[j] / a;
    272:   BVMultColumn(V,-1.0,1.0/a,n,work);
    273:   SVDOrthogonalizeCGS(V,n,work,a,refine,eta,&b);
    274:   BVSetActiveColumns(V,nconv,n);
    275:   alpha[n-1] = a;
    276:   beta[n-1] = b;
    277:   return(0);
    278: }

    282: PetscErrorCode SVDSolve_TRLanczos(SVD svd)
    283: {
    285:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
    286:   PetscReal      *alpha,*beta,lastbeta,norm,resnorm;
    287:   PetscScalar    *Q,*swork=NULL,*w;
    288:   PetscInt       i,k,l,nv,ld;
    289:   Mat            U,VT;
    290:   PetscBool      conv;
    291:   BVOrthogType   orthog;

    294:   PetscCitationsRegister(citation,&cited);
    295:   /* allocate working space */
    296:   DSGetLeadingDimension(svd->ds,&ld);
    297:   BVGetOrthogonalization(svd->V,&orthog,NULL,NULL,NULL);
    298:   PetscMalloc1(ld,&w);
    299:   if (lanczos->oneside) {
    300:     PetscMalloc1(svd->ncv+1,&swork);
    301:   }

    303:   /* normalize start vector */
    304:   if (!svd->nini) {
    305:     BVSetRandomColumn(svd->V,0);
    306:     BVNormColumn(svd->V,0,NORM_2,&norm);
    307:     BVScaleColumn(svd->V,0,1.0/norm);
    308:   }

    310:   l = 0;
    311:   while (svd->reason == SVD_CONVERGED_ITERATING) {
    312:     svd->its++;

    314:     /* inner loop */
    315:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
    316:     BVSetActiveColumns(svd->V,svd->nconv,nv);
    317:     BVSetActiveColumns(svd->U,svd->nconv,nv);
    318:     DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
    319:     beta = alpha + ld;
    320:     if (lanczos->oneside) {
    321:       if (orthog == BV_ORTHOG_MGS) {
    322:         SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);
    323:       } else {
    324:         SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);
    325:       }
    326:     } else {
    327:       SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv+l,nv);
    328:     }
    329:     lastbeta = beta[nv-1];
    330:     DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
    331:     BVScaleColumn(svd->V,nv,1.0/lastbeta);

    333:     /* compute SVD of general matrix */
    334:     DSSetDimensions(svd->ds,nv,nv,svd->nconv,svd->nconv+l);
    335:     if (l==0) {
    336:       DSSetState(svd->ds,DS_STATE_INTERMEDIATE);
    337:     } else {
    338:       DSSetState(svd->ds,DS_STATE_RAW);
    339:     }
    340:     DSSolve(svd->ds,w,NULL);
    341:     DSSort(svd->ds,w,NULL,NULL,NULL,NULL);

    343:     /* compute error estimates */
    344:     k = 0;
    345:     conv = PETSC_TRUE;
    346:     DSGetArray(svd->ds,DS_MAT_U,&Q);
    347:     DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
    348:     beta = alpha + ld;
    349:     for (i=svd->nconv;i<nv;i++) {
    350:       svd->sigma[i] = PetscRealPart(w[i]);
    351:       beta[i] = PetscRealPart(Q[nv-1+i*ld])*lastbeta;
    352:       resnorm = PetscAbsReal(beta[i]);
    353:       (*svd->converged)(svd,svd->sigma[i],resnorm,&svd->errest[i],svd->convergedctx);
    354:       if (conv) {
    355:         if (svd->errest[i] < svd->tol) k++;
    356:         else conv = PETSC_FALSE;
    357:       }
    358:     }
    359:     DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
    360:     DSRestoreArray(svd->ds,DS_MAT_U,&Q);

    362:     /* check convergence and update l */
    363:     (*svd->stopping)(svd,svd->its,svd->max_it,svd->nconv+k,svd->nsv,&svd->reason,svd->stoppingctx);
    364:     if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
    365:     else l = PetscMax((nv-svd->nconv-k)/2,0);

    367:     /* compute converged singular vectors and restart vectors */
    368:     DSGetMat(svd->ds,DS_MAT_VT,&VT);
    369:     BVMultInPlaceTranspose(svd->V,VT,svd->nconv,svd->nconv+k+l);
    370:     MatDestroy(&VT);
    371:     DSGetMat(svd->ds,DS_MAT_U,&U);
    372:     BVMultInPlace(svd->U,U,svd->nconv,svd->nconv+k+l);
    373:     MatDestroy(&U);

    375:     /* copy the last vector to be the next initial vector */
    376:     if (svd->reason == SVD_CONVERGED_ITERATING) {
    377:       BVCopyColumn(svd->V,nv,svd->nconv+k+l);
    378:     }

    380:     svd->nconv += k;
    381:     SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
    382:   }

    384:   /* orthonormalize U columns in one side method */
    385:   if (lanczos->oneside) {
    386:     for (i=0;i<svd->nconv;i++) {
    387:       BVOrthogonalizeColumn(svd->U,i,NULL,&norm,NULL);
    388:       BVScaleColumn(svd->U,i,1.0/norm);
    389:     }
    390:   }

    392:   /* free working space */
    393:   PetscFree(w);
    394:   if (swork) { PetscFree(swork); }
    395:   return(0);
    396: }

    400: PetscErrorCode SVDSetFromOptions_TRLanczos(PetscOptionItems *PetscOptionsObject,SVD svd)
    401: {
    403:   PetscBool      set,val;
    404:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

    407:   PetscOptionsHead(PetscOptionsObject,"SVD TRLanczos Options");
    408:   PetscOptionsBool("-svd_trlanczos_oneside","Lanczos one-side reorthogonalization","SVDTRLanczosSetOneSide",lanczos->oneside,&val,&set);
    409:   if (set) {
    410:     SVDTRLanczosSetOneSide(svd,val);
    411:   }
    412:   PetscOptionsTail();
    413:   return(0);
    414: }

    418: static PetscErrorCode SVDTRLanczosSetOneSide_TRLanczos(SVD svd,PetscBool oneside)
    419: {
    420:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    423:   lanczos->oneside = oneside;
    424:   return(0);
    425: }

    429: /*@
    430:    SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
    431:    to be used is one-sided or two-sided.

    433:    Logically Collective on SVD

    435:    Input Parameters:
    436: +  svd     - singular value solver
    437: -  oneside - boolean flag indicating if the method is one-sided or not

    439:    Options Database Key:
    440: .  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag

    442:    Note:
    443:    By default, a two-sided variant is selected, which is sometimes slightly
    444:    more robust. However, the one-sided variant is faster because it avoids
    445:    the orthogonalization associated to left singular vectors.

    447:    Level: advanced

    449: .seealso: SVDLanczosSetOneSide()
    450: @*/
    451: PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscBool oneside)
    452: {

    458:   PetscTryMethod(svd,"SVDTRLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
    459:   return(0);
    460: }

    464: static PetscErrorCode SVDTRLanczosGetOneSide_TRLanczos(SVD svd,PetscBool *oneside)
    465: {
    466:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    469:   *oneside = lanczos->oneside;
    470:   return(0);
    471: }

    475: /*@
    476:    SVDTRLanczosGetOneSide - Gets if the variant of the Lanczos method
    477:    to be used is one-sided or two-sided.

    479:    Not Collective

    481:    Input Parameters:
    482: .  svd     - singular value solver

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

    487:    Level: advanced

    489: .seealso: SVDTRLanczosSetOneSide()
    490: @*/
    491: PetscErrorCode SVDTRLanczosGetOneSide(SVD svd,PetscBool *oneside)
    492: {

    498:   PetscUseMethod(svd,"SVDTRLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
    499:   return(0);
    500: }

    504: PetscErrorCode SVDDestroy_TRLanczos(SVD svd)
    505: {

    509:   PetscFree(svd->data);
    510:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",NULL);
    511:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",NULL);
    512:   return(0);
    513: }

    517: PetscErrorCode SVDView_TRLanczos(SVD svd,PetscViewer viewer)
    518: {
    520:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
    521:   PetscBool      isascii;

    524:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    525:   if (isascii) {
    526:     PetscViewerASCIIPrintf(viewer,"  TRLanczos: %s-sided reorthogonalization\n",lanczos->oneside? "one": "two");
    527:   }
    528:   return(0);
    529: }

    533: PETSC_EXTERN PetscErrorCode SVDCreate_TRLanczos(SVD svd)
    534: {
    536:   SVD_TRLANCZOS  *ctx;

    539:   PetscNewLog(svd,&ctx);
    540:   svd->data = (void*)ctx;

    542:   svd->ops->setup          = SVDSetUp_TRLanczos;
    543:   svd->ops->solve          = SVDSolve_TRLanczos;
    544:   svd->ops->destroy        = SVDDestroy_TRLanczos;
    545:   svd->ops->setfromoptions = SVDSetFromOptions_TRLanczos;
    546:   svd->ops->view           = SVDView_TRLanczos;
    547:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",SVDTRLanczosSetOneSide_TRLanczos);
    548:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",SVDTRLanczosGetOneSide_TRLanczos);
    549:   return(0);
    550: }