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

Actual source code: trlanczos.c

      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:    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_TRLANCZOS;

     54: PetscErrorCode SVDSetUp_TRLanczos(SVD svd)
     55: {
     57:   PetscInt       N;

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

     87: static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,Vec *V,Vec v,Vec* U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
     88: {
     90:   PetscReal      a,b;
     91:   PetscInt       i,k=nconv+l;

     94:   SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);
     95:   if (l>0) {
     96:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
     97:     SlepcVecMAXPBY(U[k],1.0,-1.0,l,work,U+nconv);
     98:   }
     99:   IPNorm(svd->ip,U[k],&a);
    100:   VecScale(U[k],1.0/a);
    101:   alpha[k] = a;
    102:   for (i=k+1;i<n;i++) {
    103:     SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);
    104:     IPOrthogonalize(svd->ip,0,NULL,i,NULL,V,V[i],work,&b,NULL);
    105:     VecScale(V[i],1.0/b);
    106:     beta[i-1] = b;

    108:     SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);
    109:     VecAXPY(U[i],-b,U[i-1]);
    110:     IPNorm(svd->ip,U[i],&a);
    111:     VecScale(U[i],1.0/a);
    112:     alpha[i] = a;
    113:   }
    114:   SVDMatMult(svd,PETSC_TRUE,U[n-1],v);
    115:   IPOrthogonalize(svd->ip,0,NULL,n,NULL,V,v,work,&b,NULL);
    116:   beta[n-1] = b;
    117:   return(0);
    118: }

    122: static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,Vec *V,Vec v,Vec* U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
    123: {
    124:   PetscErrorCode     ierr;
    125:   PetscReal          a,b,sum,onorm,eta;
    126:   PetscScalar        dot;
    127:   PetscInt           i,j,k=nconv+l;
    128:   IPOrthogRefineType refine;

    131:   SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);
    132:   if (l>0) {
    133:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
    134:     SlepcVecMAXPBY(U[k],1.0,-1.0,l,work,U+nconv);
    135:   }
    136:   IPGetOrthogonalization(svd->ip,NULL,&refine,&eta);
    137:   for (i=k+1;i<n;i++) {
    138:     SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);
    139:     IPNormBegin(svd->ip,U[i-1],&a);
    140:     if (refine == IP_ORTHOG_REFINE_IFNEEDED) {
    141:       IPInnerProductBegin(svd->ip,V[i],V[i],&dot);
    142:     }
    143:     IPMInnerProductBegin(svd->ip,V[i],i,V,work);
    144:     IPNormEnd(svd->ip,U[i-1],&a);
    145:     if (refine == IP_ORTHOG_REFINE_IFNEEDED) {
    146:       IPInnerProductEnd(svd->ip,V[i],V[i],&dot);
    147:     }
    148:     IPMInnerProductEnd(svd->ip,V[i],i,V,work);

    150:     VecScale(U[i-1],1.0/a);
    151:     for (j=0;j<i;j++) work[j] = work[j] / a;
    152:     SlepcVecMAXPBY(V[i],1.0/a,-1.0,i,work,V);

    154:     switch (refine) {
    155:     case IP_ORTHOG_REFINE_NEVER:
    156:       IPNorm(svd->ip,V[i],&b);
    157:       break;
    158:     case IP_ORTHOG_REFINE_ALWAYS:
    159:       IPOrthogonalizeCGS1(svd->ip,0,NULL,i,NULL,V,V[i],work,NULL,&b);
    160:       break;
    161:     case IP_ORTHOG_REFINE_IFNEEDED:
    162:       onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
    163:       sum = 0.0;
    164:       for (j=0;j<i;j++) {
    165:         sum += PetscRealPart(work[j] * PetscConj(work[j]));
    166:       }
    167:       b = PetscRealPart(dot)/(a*a) - sum;
    168:       if (b>0.0) b = PetscSqrtReal(b);
    169:       else {
    170:         IPNorm(svd->ip,V[i],&b);
    171:       }
    172:       if (b < eta*onorm) {
    173:         IPOrthogonalizeCGS1(svd->ip,0,NULL,i,NULL,V,V[i],work,NULL,&b);
    174:       }
    175:       break;
    176:     }

    178:     VecScale(V[i],1.0/b);

    180:     SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);
    181:     VecAXPY(U[i],-b,U[i-1]);

    183:     alpha[i-1] = a;
    184:     beta[i-1] = b;
    185:   }
    186:   SVDMatMult(svd,PETSC_TRUE,U[n-1],v);
    187:   IPNormBegin(svd->ip,U[n-1],&a);
    188:   if (refine == IP_ORTHOG_REFINE_IFNEEDED) {
    189:     IPInnerProductBegin(svd->ip,v,v,&dot);
    190:   }
    191:   IPMInnerProductBegin(svd->ip,v,n,V,work);
    192:   IPNormEnd(svd->ip,U[n-1],&a);
    193:   if (refine == IP_ORTHOG_REFINE_IFNEEDED) {
    194:     IPInnerProductEnd(svd->ip,v,v,&dot);
    195:   }
    196:   IPMInnerProductEnd(svd->ip,v,n,V,work);

    198:   VecScale(U[n-1],1.0/a);
    199:   for (j=0;j<n;j++) work[j] = work[j] / a;
    200:   SlepcVecMAXPBY(v,1.0/a,-1.0,n,work,V);

    202:   switch (refine) {
    203:   case IP_ORTHOG_REFINE_NEVER:
    204:     IPNorm(svd->ip,v,&b);
    205:     break;
    206:   case IP_ORTHOG_REFINE_ALWAYS:
    207:     IPOrthogonalizeCGS1(svd->ip,0,NULL,n,NULL,V,v,work,NULL,&b);
    208:     break;
    209:   case IP_ORTHOG_REFINE_IFNEEDED:
    210:     onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
    211:     sum = 0.0;
    212:     for (j=0;j<i;j++) {
    213:       sum += PetscRealPart(work[j] * PetscConj(work[j]));
    214:     }
    215:     b = PetscRealPart(dot)/(a*a) - sum;
    216:     if (b>0.0) b = PetscSqrtReal(b);
    217:     else {
    218:       IPNorm(svd->ip,v,&b);
    219:     }
    220:     if (b < eta*onorm) {
    221:       IPOrthogonalizeCGS1(svd->ip,0,NULL,n,NULL,V,v,work,NULL,&b);
    222:     }
    223:     break;
    224:   }

    226:   alpha[n-1] = a;
    227:   beta[n-1] = b;
    228:   return(0);
    229: }

    233: PetscErrorCode SVDSolve_TRLanczos(SVD svd)
    234: {
    236:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
    237:   PetscReal      *alpha,*beta,lastbeta,norm;
    238:   PetscScalar    *Q,*PT,*swork,*w;
    239:   PetscInt       i,k,l,nv,ld,off;
    240:   Vec            v;
    241:   PetscBool      conv;
    242:   IPOrthogType   orthog;

    245:   /* allocate working space */
    246:   DSGetLeadingDimension(svd->ds,&ld);
    247:   PetscMalloc(sizeof(PetscScalar)*ld,&w);
    248:   PetscMalloc(sizeof(PetscScalar)*svd->n,&swork);
    249:   VecDuplicate(svd->V[0],&v);
    250:   IPGetOrthogonalization(svd->ip,&orthog,NULL,NULL);

    252:   /* normalize start vector */
    253:   if (!svd->nini) {
    254:     SlepcVecSetRandom(svd->V[0],svd->rand);
    255:   }
    256:   VecNormalize(svd->V[0],&norm);

    258:   l = 0;
    259:   while (svd->reason == SVD_CONVERGED_ITERATING) {
    260:     svd->its++;

    262:     /* inner loop */
    263:     nv = PetscMin(svd->nconv+svd->mpd,svd->n);
    264:     DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
    265:     beta = alpha + ld;
    266:     if (lanczos->oneside) {
    267:       if (orthog == IP_ORTHOG_MGS) {
    268:         SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,v,svd->U,svd->nconv,l,nv,swork);
    269:       } else {
    270:         SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,v,svd->U,svd->nconv,l,nv,swork);
    271:       }
    272:     } else {
    273:       SVDTwoSideLanczos(svd,alpha,beta,svd->V,v,svd->U,svd->nconv+l,nv,swork);
    274:     }
    275:     lastbeta = beta[nv-1];
    276:     DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
    277:     VecScale(v,1.0/lastbeta);

    279:     /* compute SVD of general matrix */
    280:     DSSetDimensions(svd->ds,nv,nv,svd->nconv,svd->nconv+l);
    281:     if (l==0) {
    282:       DSSetState(svd->ds,DS_STATE_INTERMEDIATE);
    283:     } else {
    284:       DSSetState(svd->ds,DS_STATE_RAW);
    285:     }
    286:     DSSolve(svd->ds,w,NULL);
    287:     DSSort(svd->ds,w,NULL,NULL,NULL,NULL);

    289:     /* compute error estimates */
    290:     k = 0;
    291:     conv = PETSC_TRUE;
    292:     DSGetArray(svd->ds,DS_MAT_U,&Q);
    293:     DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
    294:     beta = alpha + ld;
    295:     for (i=svd->nconv;i<nv;i++) {
    296:       svd->sigma[i] = PetscRealPart(w[i]);
    297:       beta[i] = PetscRealPart(Q[nv-1+i*ld])*lastbeta;
    298:       svd->errest[i] = PetscAbsScalar(beta[i]);
    299:       if (svd->sigma[i] > svd->tol) svd->errest[i] /= svd->sigma[i];
    300:       if (conv) {
    301:         if (svd->errest[i] < svd->tol) k++;
    302:         else conv = PETSC_FALSE;
    303:       }
    304:     }
    305:     DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);

    307:     /* check convergence and update l */
    308:     if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
    309:     if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
    310:     if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
    311:     else l = PetscMax((nv-svd->nconv-k)/2,0);

    313:     /* compute converged singular vectors and restart vectors */
    314:     off = svd->nconv+svd->nconv*ld;
    315:     DSGetArray(svd->ds,DS_MAT_VT,&PT);
    316:     SlepcUpdateVectors(nv-svd->nconv,svd->V+svd->nconv,0,k+l,PT+off,ld,PETSC_TRUE);
    317:     SlepcUpdateVectors(nv-svd->nconv,svd->U+svd->nconv,0,k+l,Q+off,ld,PETSC_FALSE);
    318:     DSRestoreArray(svd->ds,DS_MAT_VT,&PT);
    319:     DSRestoreArray(svd->ds,DS_MAT_U,&Q);

    321:     /* copy the last vector to be the next initial vector */
    322:     if (svd->reason == SVD_CONVERGED_ITERATING) {
    323:       VecCopy(v,svd->V[svd->nconv+k+l]);
    324:     }

    326:     svd->nconv += k;
    327:     SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
    328:   }

    330:   /* orthonormalize U columns in one side method */
    331:   if (lanczos->oneside) {
    332:     for (i=0;i<svd->nconv;i++) {
    333:       IPOrthogonalize(svd->ip,0,NULL,i,NULL,svd->U,svd->U[i],NULL,&norm,NULL);
    334:       VecScale(svd->U[i],1.0/norm);
    335:     }
    336:   }

    338:   /* free working space */
    339:   VecDestroy(&v);
    340:   PetscFree(w);
    341:   PetscFree(swork);
    342:   return(0);
    343: }

    347: PetscErrorCode SVDSetFromOptions_TRLanczos(SVD svd)
    348: {
    350:   PetscBool      set,val;
    351:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

    354:   PetscOptionsHead("SVD TRLanczos Options");
    355:   PetscOptionsBool("-svd_trlanczos_oneside","Lanczos one-side reorthogonalization","SVDTRLanczosSetOneSide",lanczos->oneside,&val,&set);
    356:   if (set) {
    357:     SVDTRLanczosSetOneSide(svd,val);
    358:   }
    359:   PetscOptionsTail();
    360:   return(0);
    361: }

    365: static PetscErrorCode SVDTRLanczosSetOneSide_TRLanczos(SVD svd,PetscBool oneside)
    366: {
    367:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    370:   lanczos->oneside = oneside;
    371:   return(0);
    372: }

    376: /*@
    377:    SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
    378:    to be used is one-sided or two-sided.

    380:    Logically Collective on SVD

    382:    Input Parameters:
    383: +  svd     - singular value solver
    384: -  oneside - boolean flag indicating if the method is one-sided or not

    386:    Options Database Key:
    387: .  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag

    389:    Note:
    390:    By default, a two-sided variant is selected, which is sometimes slightly
    391:    more robust. However, the one-sided variant is faster because it avoids
    392:    the orthogonalization associated to left singular vectors.

    394:    Level: advanced

    396: .seealso: SVDLanczosSetOneSide()
    397: @*/
    398: PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscBool oneside)
    399: {

    405:   PetscTryMethod(svd,"SVDTRLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
    406:   return(0);
    407: }

    411: /*@
    412:    SVDTRLanczosGetOneSide - Gets if the variant of the Lanczos method
    413:    to be used is one-sided or two-sided.

    415:    Not Collective

    417:    Input Parameters:
    418: .  svd     - singular value solver

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

    423:    Level: advanced

    425: .seealso: SVDTRLanczosSetOneSide()
    426: @*/
    427: PetscErrorCode SVDTRLanczosGetOneSide(SVD svd,PetscBool *oneside)
    428: {

    434:   PetscTryMethod(svd,"SVDTRLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
    435:   return(0);
    436: }

    440: static PetscErrorCode SVDTRLanczosGetOneSide_TRLanczos(SVD svd,PetscBool *oneside)
    441: {
    442:   SVD_TRLANCZOS    *lanczos = (SVD_TRLANCZOS*)svd->data;

    445:   *oneside = lanczos->oneside;
    446:   return(0);
    447: }

    451: PetscErrorCode SVDReset_TRLanczos(SVD svd)
    452: {

    456:   VecDestroyVecs(svd->n,&svd->U);
    457:   return(0);
    458: }

    462: PetscErrorCode SVDDestroy_TRLanczos(SVD svd)
    463: {

    467:   PetscFree(svd->data);
    468:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",NULL);
    469:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",NULL);
    470:   return(0);
    471: }

    475: PetscErrorCode SVDView_TRLanczos(SVD svd,PetscViewer viewer)
    476: {
    478:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

    481:   PetscViewerASCIIPrintf(viewer,"  TRLanczos: %s-sided reorthogonalization\n",lanczos->oneside? "one": "two");
    482:   return(0);
    483: }

    487: PETSC_EXTERN PetscErrorCode SVDCreate_TRLanczos(SVD svd)
    488: {

    492:   PetscNewLog(svd,SVD_TRLANCZOS,&svd->data);
    493:   svd->ops->setup          = SVDSetUp_TRLanczos;
    494:   svd->ops->solve          = SVDSolve_TRLanczos;
    495:   svd->ops->destroy        = SVDDestroy_TRLanczos;
    496:   svd->ops->reset          = SVDReset_TRLanczos;
    497:   svd->ops->setfromoptions = SVDSetFromOptions_TRLanczos;
    498:   svd->ops->view           = SVDView_TRLanczos;
    499:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",SVDTRLanczosSetOneSide_TRLanczos);
    500:   PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",SVDTRLanczosGetOneSide_TRLanczos);
    501:   return(0);
    502: }