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: }