Actual source code: trlanczos.c
slepc-3.6.1 2015-09-03
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-2015, 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: typedef struct {
45: PetscBool oneside;
46: } SVD_TRLANCZOS;
50: PetscErrorCode SVDSetUp_TRLanczos(SVD svd)
51: {
53: PetscInt N;
56: SVDMatGetSize(svd,NULL,&N);
57: SVDSetDimensions_Default(svd);
58: if (svd->ncv>svd->nsv+svd->mpd) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The value of ncv must not be larger than nev+mpd");
59: if (!svd->max_it) svd->max_it = PetscMax(N/svd->ncv,100);
60: svd->leftbasis = PETSC_TRUE;
61: SVDAllocateSolution(svd,1);
62: DSSetType(svd->ds,DSSVD);
63: DSSetCompact(svd->ds,PETSC_TRUE);
64: DSAllocate(svd->ds,svd->ncv);
65: return(0);
66: }
70: static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
71: {
73: PetscReal a,b;
74: PetscInt i,k=nconv+l;
75: Vec ui,ui1,vi;
78: BVGetColumn(V,k,&vi);
79: BVGetColumn(U,k,&ui);
80: SVDMatMult(svd,PETSC_FALSE,vi,ui);
81: BVRestoreColumn(V,k,&vi);
82: BVRestoreColumn(U,k,&ui);
83: if (l>0) {
84: for (i=0;i<l;i++) work[i]=beta[i+nconv];
85: BVMultColumn(U,-1.0,1.0,k,work);
86: }
87: BVNormColumn(U,k,NORM_2,&a);
88: BVScaleColumn(U,k,1.0/a);
89: alpha[k] = a;
91: for (i=k+1;i<n;i++) {
92: BVGetColumn(V,i,&vi);
93: BVGetColumn(U,i-1,&ui1);
94: SVDMatMult(svd,PETSC_TRUE,ui1,vi);
95: BVRestoreColumn(V,i,&vi);
96: BVRestoreColumn(U,i-1,&ui1);
97: BVOrthogonalizeColumn(V,i,NULL,&b,NULL);
98: BVScaleColumn(V,i,1.0/b);
99: beta[i-1] = b;
101: BVGetColumn(V,i,&vi);
102: BVGetColumn(U,i,&ui);
103: SVDMatMult(svd,PETSC_FALSE,vi,ui);
104: BVRestoreColumn(V,i,&vi);
105: BVGetColumn(U,i-1,&ui1);
106: VecAXPY(ui,-b,ui1);
107: BVRestoreColumn(U,i-1,&ui1);
108: BVRestoreColumn(U,i,&ui);
109: BVNormColumn(U,i,NORM_2,&a);
110: BVScaleColumn(U,i,1.0/a);
111: alpha[i] = a;
112: }
114: BVGetColumn(V,n,&vi);
115: BVGetColumn(U,n-1,&ui1);
116: SVDMatMult(svd,PETSC_TRUE,ui1,vi);
117: BVRestoreColumn(V,n,&vi);
118: BVRestoreColumn(U,n-1,&ui1);
119: BVOrthogonalizeColumn(V,n,NULL,&b,NULL);
120: beta[n-1] = b;
121: return(0);
122: }
126: /*
127: Custom CGS orthogonalization, preprocess after first orthogonalization
128: */
129: static PetscErrorCode SVDOrthogonalizeCGS(BV V,PetscInt i,PetscScalar* h,PetscReal a,BVOrthogRefineType refine,PetscReal eta,PetscReal *norm)
130: {
132: PetscReal sum,onorm;
133: PetscScalar dot;
134: PetscInt j;
137: switch (refine) {
138: case BV_ORTHOG_REFINE_NEVER:
139: BVNormColumn(V,i,NORM_2,norm);
140: break;
141: case BV_ORTHOG_REFINE_ALWAYS:
142: BVSetActiveColumns(V,0,i);
143: BVDotColumn(V,i,h);
144: BVMultColumn(V,-1.0,1.0,i,h);
145: BVNormColumn(V,i,NORM_2,norm);
146: break;
147: case BV_ORTHOG_REFINE_IFNEEDED:
148: dot = h[i];
149: onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
150: sum = 0.0;
151: for (j=0;j<i;j++) {
152: sum += PetscRealPart(h[j] * PetscConj(h[j]));
153: }
154: *norm = PetscRealPart(dot)/(a*a) - sum;
155: if (*norm>0.0) *norm = PetscSqrtReal(*norm);
156: else {
157: BVNormColumn(V,i,NORM_2,norm);
158: }
159: if (*norm < eta*onorm) {
160: BVSetActiveColumns(V,0,i);
161: BVDotColumn(V,i,h);
162: BVMultColumn(V,-1.0,1.0,i,h);
163: BVNormColumn(V,i,NORM_2,norm);
164: }
165: break;
166: }
167: return(0);
168: }
172: static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
173: {
174: PetscErrorCode ierr;
175: PetscReal a,b,eta;
176: PetscInt i,j,k=nconv+l;
177: Vec ui,ui1,vi;
178: BVOrthogRefineType refine;
181: BVGetColumn(V,k,&vi);
182: BVGetColumn(U,k,&ui);
183: SVDMatMult(svd,PETSC_FALSE,vi,ui);
184: BVRestoreColumn(V,k,&vi);
185: BVRestoreColumn(U,k,&ui);
186: if (l>0) {
187: for (i=0;i<l;i++) work[i]=beta[i+nconv];
188: BVMultColumn(U,-1.0,1.0,k,work);
189: }
190: BVGetOrthogonalization(V,NULL,&refine,&eta,NULL);
192: for (i=k+1;i<n;i++) {
193: BVGetColumn(V,i,&vi);
194: BVGetColumn(U,i-1,&ui1);
195: SVDMatMult(svd,PETSC_TRUE,ui1,vi);
196: BVRestoreColumn(V,i,&vi);
197: BVRestoreColumn(U,i-1,&ui1);
198: BVNormColumnBegin(U,i-1,NORM_2,&a);
199: if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
200: BVSetActiveColumns(V,0,i+1);
201: BVGetColumn(V,i,&vi);
202: BVDotVecBegin(V,vi,work);
203: } else {
204: BVSetActiveColumns(V,0,i);
205: BVDotColumnBegin(V,i,work);
206: }
207: BVNormColumnEnd(U,i-1,NORM_2,&a);
208: if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
209: BVDotVecEnd(V,vi,work);
210: BVRestoreColumn(V,i,&vi);
211: BVSetActiveColumns(V,0,i);
212: } else {
213: BVDotColumnEnd(V,i,work);
214: }
216: BVScaleColumn(U,i-1,1.0/a);
217: for (j=0;j<i;j++) work[j] = work[j] / a;
218: BVMultColumn(V,-1.0,1.0/a,i,work);
219: SVDOrthogonalizeCGS(V,i,work,a,refine,eta,&b);
220: BVScaleColumn(V,i,1.0/b);
222: BVGetColumn(V,i,&vi);
223: BVGetColumn(U,i,&ui);
224: BVGetColumn(U,i-1,&ui1);
225: SVDMatMult(svd,PETSC_FALSE,vi,ui);
226: VecAXPY(ui,-b,ui1);
227: BVRestoreColumn(V,i,&vi);
228: BVRestoreColumn(U,i,&ui);
229: BVRestoreColumn(U,i-1,&ui1);
231: alpha[i-1] = a;
232: beta[i-1] = b;
233: }
235: BVGetColumn(V,n,&vi);
236: BVGetColumn(U,n-1,&ui1);
237: SVDMatMult(svd,PETSC_TRUE,ui1,vi);
238: BVRestoreColumn(V,n,&vi);
239: BVRestoreColumn(U,n-1,&ui1);
241: BVNormColumnBegin(svd->U,n-1,NORM_2,&a);
242: if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
243: BVSetActiveColumns(V,0,n+1);
244: BVGetColumn(V,n,&vi);
245: BVDotVecBegin(V,vi,work);
246: } else {
247: BVSetActiveColumns(V,0,n);
248: BVDotColumnBegin(V,n,work);
249: }
250: BVNormColumnEnd(svd->U,n-1,NORM_2,&a);
251: if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
252: BVDotVecEnd(V,vi,work);
253: BVRestoreColumn(V,n,&vi);
254: } else {
255: BVDotColumnEnd(V,n,work);
256: }
258: BVScaleColumn(U,n-1,1.0/a);
259: for (j=0;j<n;j++) work[j] = work[j] / a;
260: BVMultColumn(V,-1.0,1.0/a,n,work);
261: SVDOrthogonalizeCGS(V,n,work,a,refine,eta,&b);
262: BVSetActiveColumns(V,nconv,n);
263: alpha[n-1] = a;
264: beta[n-1] = b;
265: return(0);
266: }
270: PetscErrorCode SVDSolve_TRLanczos(SVD svd)
271: {
273: SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
274: PetscReal *alpha,*beta,lastbeta,norm;
275: PetscScalar *Q,*swork=NULL,*w;
276: PetscInt i,k,l,nv,ld;
277: Mat U,VT;
278: PetscBool conv;
279: BVOrthogType orthog;
282: /* allocate working space */
283: DSGetLeadingDimension(svd->ds,&ld);
284: BVGetOrthogonalization(svd->V,&orthog,NULL,NULL,NULL);
285: PetscMalloc1(ld,&w);
286: if (lanczos->oneside) {
287: PetscMalloc1(svd->ncv+1,&swork);
288: }
290: /* normalize start vector */
291: if (!svd->nini) {
292: BVSetRandomColumn(svd->V,0,svd->rand);
293: BVNormColumn(svd->V,0,NORM_2,&norm);
294: BVScaleColumn(svd->V,0,1.0/norm);
295: }
297: l = 0;
298: while (svd->reason == SVD_CONVERGED_ITERATING) {
299: svd->its++;
301: /* inner loop */
302: nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
303: BVSetActiveColumns(svd->V,svd->nconv,nv);
304: BVSetActiveColumns(svd->U,svd->nconv,nv);
305: DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
306: beta = alpha + ld;
307: if (lanczos->oneside) {
308: if (orthog == BV_ORTHOG_MGS) {
309: SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);
310: } else {
311: SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);
312: }
313: } else {
314: SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv+l,nv);
315: }
316: lastbeta = beta[nv-1];
317: DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
318: BVScaleColumn(svd->V,nv,1.0/lastbeta);
320: /* compute SVD of general matrix */
321: DSSetDimensions(svd->ds,nv,nv,svd->nconv,svd->nconv+l);
322: if (l==0) {
323: DSSetState(svd->ds,DS_STATE_INTERMEDIATE);
324: } else {
325: DSSetState(svd->ds,DS_STATE_RAW);
326: }
327: DSSolve(svd->ds,w,NULL);
328: DSSort(svd->ds,w,NULL,NULL,NULL,NULL);
330: /* compute error estimates */
331: k = 0;
332: conv = PETSC_TRUE;
333: DSGetArray(svd->ds,DS_MAT_U,&Q);
334: DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
335: beta = alpha + ld;
336: for (i=svd->nconv;i<nv;i++) {
337: svd->sigma[i] = PetscRealPart(w[i]);
338: beta[i] = PetscRealPart(Q[nv-1+i*ld])*lastbeta;
339: svd->errest[i] = PetscAbsReal(beta[i]);
340: if (svd->sigma[i] > svd->tol) svd->errest[i] /= svd->sigma[i];
341: if (conv) {
342: if (svd->errest[i] < svd->tol) k++;
343: else conv = PETSC_FALSE;
344: }
345: }
346: DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
347: DSRestoreArray(svd->ds,DS_MAT_U,&Q);
349: /* check convergence and update l */
350: if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
351: if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
352: if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
353: else l = PetscMax((nv-svd->nconv-k)/2,0);
355: /* compute converged singular vectors and restart vectors */
356: DSGetMat(svd->ds,DS_MAT_VT,&VT);
357: BVMultInPlaceTranspose(svd->V,VT,svd->nconv,svd->nconv+k+l);
358: MatDestroy(&VT);
359: DSGetMat(svd->ds,DS_MAT_U,&U);
360: BVMultInPlace(svd->U,U,svd->nconv,svd->nconv+k+l);
361: MatDestroy(&U);
363: /* copy the last vector to be the next initial vector */
364: if (svd->reason == SVD_CONVERGED_ITERATING) {
365: BVCopyColumn(svd->V,nv,svd->nconv+k+l);
366: }
368: svd->nconv += k;
369: SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
370: }
372: /* orthonormalize U columns in one side method */
373: if (lanczos->oneside) {
374: for (i=0;i<svd->nconv;i++) {
375: BVOrthogonalizeColumn(svd->U,i,NULL,&norm,NULL);
376: BVScaleColumn(svd->U,i,1.0/norm);
377: }
378: }
380: /* free working space */
381: PetscFree(w);
382: if (swork) { PetscFree(swork); }
383: return(0);
384: }
388: PetscErrorCode SVDSetFromOptions_TRLanczos(PetscOptions *PetscOptionsObject,SVD svd)
389: {
391: PetscBool set,val;
392: SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
395: PetscOptionsHead(PetscOptionsObject,"SVD TRLanczos Options");
396: PetscOptionsBool("-svd_trlanczos_oneside","Lanczos one-side reorthogonalization","SVDTRLanczosSetOneSide",lanczos->oneside,&val,&set);
397: if (set) {
398: SVDTRLanczosSetOneSide(svd,val);
399: }
400: PetscOptionsTail();
401: return(0);
402: }
406: static PetscErrorCode SVDTRLanczosSetOneSide_TRLanczos(SVD svd,PetscBool oneside)
407: {
408: SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
411: lanczos->oneside = oneside;
412: return(0);
413: }
417: /*@
418: SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
419: to be used is one-sided or two-sided.
421: Logically Collective on SVD
423: Input Parameters:
424: + svd - singular value solver
425: - oneside - boolean flag indicating if the method is one-sided or not
427: Options Database Key:
428: . -svd_trlanczos_oneside <boolean> - Indicates the boolean flag
430: Note:
431: By default, a two-sided variant is selected, which is sometimes slightly
432: more robust. However, the one-sided variant is faster because it avoids
433: the orthogonalization associated to left singular vectors.
435: Level: advanced
437: .seealso: SVDLanczosSetOneSide()
438: @*/
439: PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscBool oneside)
440: {
446: PetscTryMethod(svd,"SVDTRLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
447: return(0);
448: }
452: /*@
453: SVDTRLanczosGetOneSide - Gets if the variant of the Lanczos method
454: to be used is one-sided or two-sided.
456: Not Collective
458: Input Parameters:
459: . svd - singular value solver
461: Output Parameters:
462: . oneside - boolean flag indicating if the method is one-sided or not
464: Level: advanced
466: .seealso: SVDTRLanczosSetOneSide()
467: @*/
468: PetscErrorCode SVDTRLanczosGetOneSide(SVD svd,PetscBool *oneside)
469: {
475: PetscTryMethod(svd,"SVDTRLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
476: return(0);
477: }
481: static PetscErrorCode SVDTRLanczosGetOneSide_TRLanczos(SVD svd,PetscBool *oneside)
482: {
483: SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
486: *oneside = lanczos->oneside;
487: return(0);
488: }
492: PetscErrorCode SVDDestroy_TRLanczos(SVD svd)
493: {
497: PetscFree(svd->data);
498: PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",NULL);
499: PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",NULL);
500: return(0);
501: }
505: PetscErrorCode SVDView_TRLanczos(SVD svd,PetscViewer viewer)
506: {
508: SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
511: PetscViewerASCIIPrintf(viewer," TRLanczos: %s-sided reorthogonalization\n",lanczos->oneside? "one": "two");
512: return(0);
513: }
517: PETSC_EXTERN PetscErrorCode SVDCreate_TRLanczos(SVD svd)
518: {
520: SVD_TRLANCZOS *ctx;
523: PetscNewLog(svd,&ctx);
524: svd->data = (void*)ctx;
526: svd->ops->setup = SVDSetUp_TRLanczos;
527: svd->ops->solve = SVDSolve_TRLanczos;
528: svd->ops->destroy = SVDDestroy_TRLanczos;
529: svd->ops->setfromoptions = SVDSetFromOptions_TRLanczos;
530: svd->ops->view = SVDView_TRLanczos;
531: PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",SVDTRLanczosSetOneSide_TRLanczos);
532: PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",SVDTRLanczosGetOneSide_TRLanczos);
533: return(0);
534: }