Actual source code: gklanczos.c
slepc-3.7.1 2016-05-27
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: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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: typedef struct {
45: PetscBool oneside;
46: } SVD_LANCZOS;
50: PetscErrorCode SVDSetUp_Lanczos(SVD svd)
51: {
53: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
54: PetscInt N;
57: SVDMatGetSize(svd,NULL,&N);
58: SVDSetDimensions_Default(svd);
59: if (svd->ncv>svd->nsv+svd->mpd) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The value of ncv must not be larger than nev+mpd");
60: if (!svd->max_it) svd->max_it = PetscMax(N/svd->ncv,100);
61: svd->leftbasis = PetscNot(lanczos->oneside);
62: SVDAllocateSolution(svd,1);
63: DSSetType(svd->ds,DSSVD);
64: DSSetCompact(svd->ds,PETSC_TRUE);
65: DSAllocate(svd->ds,svd->ncv);
66: return(0);
67: }
71: PetscErrorCode SVDTwoSideLanczos(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt k,PetscInt n)
72: {
74: PetscInt i;
75: Vec u,v;
78: BVGetColumn(svd->V,k,&v);
79: BVGetColumn(svd->U,k,&u);
80: SVDMatMult(svd,PETSC_FALSE,v,u);
81: BVRestoreColumn(svd->V,k,&v);
82: BVRestoreColumn(svd->U,k,&u);
83: BVOrthogonalizeColumn(svd->U,k,NULL,alpha+k,NULL);
84: BVScaleColumn(U,k,1.0/alpha[k]);
86: for (i=k+1;i<n;i++) {
87: BVGetColumn(svd->V,i,&v);
88: BVGetColumn(svd->U,i-1,&u);
89: SVDMatMult(svd,PETSC_TRUE,u,v);
90: BVRestoreColumn(svd->V,i,&v);
91: BVRestoreColumn(svd->U,i-1,&u);
92: BVOrthogonalizeColumn(svd->V,i,NULL,beta+i-1,NULL);
93: BVScaleColumn(V,i,1.0/beta[i-1]);
95: BVGetColumn(svd->V,i,&v);
96: BVGetColumn(svd->U,i,&u);
97: SVDMatMult(svd,PETSC_FALSE,v,u);
98: BVRestoreColumn(svd->V,i,&v);
99: BVRestoreColumn(svd->U,i,&u);
100: BVOrthogonalizeColumn(svd->U,i,NULL,alpha+i,NULL);
101: BVScaleColumn(U,i,1.0/alpha[i]);
102: }
104: BVGetColumn(svd->V,n,&v);
105: BVGetColumn(svd->U,n-1,&u);
106: SVDMatMult(svd,PETSC_TRUE,u,v);
107: BVRestoreColumn(svd->V,n,&v);
108: BVRestoreColumn(svd->U,n-1,&u);
109: BVOrthogonalizeColumn(svd->V,n,NULL,beta+n-1,NULL);
110: return(0);
111: }
115: static PetscErrorCode SVDOneSideLanczos(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,Vec u,Vec u_1,PetscInt k,PetscInt n,PetscScalar* work)
116: {
118: PetscInt i,bvl,bvk;
119: PetscReal a,b;
120: Vec z,temp;
123: BVGetActiveColumns(V,&bvl,&bvk);
124: BVGetColumn(V,k,&z);
125: SVDMatMult(svd,PETSC_FALSE,z,u);
126: BVRestoreColumn(V,k,&z);
128: for (i=k+1;i<n;i++) {
129: BVGetColumn(V,i,&z);
130: SVDMatMult(svd,PETSC_TRUE,u,z);
131: BVRestoreColumn(V,i,&z);
132: VecNormBegin(u,NORM_2,&a);
133: BVSetActiveColumns(V,0,i);
134: BVDotColumnBegin(V,i,work);
135: VecNormEnd(u,NORM_2,&a);
136: BVDotColumnEnd(V,i,work);
137: VecScale(u,1.0/a);
138: BVMultColumn(V,-1.0/a,1.0/a,i,work);
140: /* h = V^* z, z = z - V h */
141: BVDotColumn(V,i,work);
142: BVMultColumn(V,-1.0,1.0,i,work);
143: BVNormColumn(V,i,NORM_2,&b);
144: if (PetscAbsReal(b)<10*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Recurrence generated a zero vector; use a two-sided variant");
145: BVScaleColumn(V,i,1.0/b);
147: BVGetColumn(V,i,&z);
148: SVDMatMult(svd,PETSC_FALSE,z,u_1);
149: BVRestoreColumn(V,i,&z);
150: VecAXPY(u_1,-b,u);
151: alpha[i-1] = a;
152: beta[i-1] = b;
153: temp = u;
154: u = u_1;
155: u_1 = temp;
156: }
158: BVGetColumn(V,n,&z);
159: SVDMatMult(svd,PETSC_TRUE,u,z);
160: BVRestoreColumn(V,n,&z);
161: VecNormBegin(u,NORM_2,&a);
162: BVDotColumnBegin(V,n,work);
163: VecNormEnd(u,NORM_2,&a);
164: BVDotColumnEnd(V,n,work);
165: VecScale(u,1.0/a);
166: BVMultColumn(V,-1.0/a,1.0/a,n,work);
168: /* h = V^* z, z = z - V h */
169: BVDotColumn(V,n,work);
170: BVMultColumn(V,-1.0,1.0,n,work);
171: BVNormColumn(V,i,NORM_2,&b);
173: alpha[n-1] = a;
174: beta[n-1] = b;
175: BVSetActiveColumns(V,bvl,bvk);
176: return(0);
177: }
181: PetscErrorCode SVDSolve_Lanczos(SVD svd)
182: {
184: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
185: PetscReal *alpha,*beta,lastbeta,norm,resnorm;
186: PetscScalar *swork,*w,*Q,*PT;
187: PetscInt i,k,j,nv,ld;
188: Vec u=0,u_1=0;
189: Mat U,VT;
190: PetscBool conv;
193: /* allocate working space */
194: DSGetLeadingDimension(svd->ds,&ld);
195: PetscMalloc2(ld,&w,svd->ncv,&swork);
197: if (lanczos->oneside) {
198: SVDMatCreateVecs(svd,NULL,&u);
199: SVDMatCreateVecs(svd,NULL,&u_1);
200: }
202: /* normalize start vector */
203: if (!svd->nini) {
204: BVSetRandomColumn(svd->V,0);
205: BVNormColumn(svd->V,0,NORM_2,&norm);
206: BVScaleColumn(svd->V,0,1.0/norm);
207: }
209: while (svd->reason == SVD_CONVERGED_ITERATING) {
210: svd->its++;
212: /* inner loop */
213: nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
214: BVSetActiveColumns(svd->V,svd->nconv,nv);
215: DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);
216: beta = alpha + ld;
217: if (lanczos->oneside) {
218: SVDOneSideLanczos(svd,alpha,beta,svd->V,u,u_1,svd->nconv,nv,swork);
219: } else {
220: BVSetActiveColumns(svd->U,svd->nconv,nv);
221: SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv,nv);
222: }
223: lastbeta = beta[nv-1];
224: DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);
226: /* compute SVD of bidiagonal matrix */
227: DSSetDimensions(svd->ds,nv,nv,svd->nconv,0);
228: DSSetState(svd->ds,DS_STATE_INTERMEDIATE);
229: DSSolve(svd->ds,w,NULL);
230: DSSort(svd->ds,w,NULL,NULL,NULL,NULL);
232: /* compute error estimates */
233: k = 0;
234: conv = PETSC_TRUE;
235: DSGetArray(svd->ds,DS_MAT_U,&Q);
236: for (i=svd->nconv;i<nv;i++) {
237: svd->sigma[i] = PetscRealPart(w[i]);
238: resnorm = PetscAbsScalar(Q[nv-1+i*ld])*lastbeta;
239: (*svd->converged)(svd,svd->sigma[i],resnorm,&svd->errest[i],svd->convergedctx);
240: if (conv) {
241: if (svd->errest[i] < svd->tol) k++;
242: else conv = PETSC_FALSE;
243: }
244: }
245: DSRestoreArray(svd->ds,DS_MAT_U,&Q);
247: /* check convergence */
248: (*svd->stopping)(svd,svd->its,svd->max_it,svd->nconv+k,svd->nsv,&svd->reason,svd->stoppingctx);
250: /* compute restart vector */
251: DSGetArray(svd->ds,DS_MAT_VT,&PT);
252: if (svd->reason == SVD_CONVERGED_ITERATING) {
253: for (j=svd->nconv;j<nv;j++) swork[j-svd->nconv] = PT[k+svd->nconv+j*ld];
254: BVMultColumn(svd->V,1.0,0.0,nv,swork);
255: }
256: DSRestoreArray(svd->ds,DS_MAT_VT,&PT);
258: /* compute converged singular vectors */
259: DSGetMat(svd->ds,DS_MAT_VT,&VT);
260: BVMultInPlaceTranspose(svd->V,VT,svd->nconv,svd->nconv+k);
261: MatDestroy(&VT);
262: if (!lanczos->oneside) {
263: DSGetMat(svd->ds,DS_MAT_U,&U);
264: BVMultInPlace(svd->U,U,svd->nconv,svd->nconv+k);
265: MatDestroy(&U);
266: }
268: /* copy restart vector from the last column */
269: if (svd->reason == SVD_CONVERGED_ITERATING) {
270: BVCopyColumn(svd->V,nv,svd->nconv+k);
271: }
273: svd->nconv += k;
274: SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
275: }
277: /* free working space */
278: VecDestroy(&u);
279: VecDestroy(&u_1);
280: PetscFree2(w,swork);
281: return(0);
282: }
286: PetscErrorCode SVDSetFromOptions_Lanczos(PetscOptionItems *PetscOptionsObject,SVD svd)
287: {
289: PetscBool set,val;
290: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
293: PetscOptionsHead(PetscOptionsObject,"SVD Lanczos Options");
294: PetscOptionsBool("-svd_lanczos_oneside","Lanczos one-side reorthogonalization","SVDLanczosSetOneSide",lanczos->oneside,&val,&set);
295: if (set) {
296: SVDLanczosSetOneSide(svd,val);
297: }
298: PetscOptionsTail();
299: return(0);
300: }
304: static PetscErrorCode SVDLanczosSetOneSide_Lanczos(SVD svd,PetscBool oneside)
305: {
306: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
309: if (lanczos->oneside != oneside) {
310: lanczos->oneside = oneside;
311: svd->state = SVD_STATE_INITIAL;
312: }
313: return(0);
314: }
318: /*@
319: SVDLanczosSetOneSide - Indicate if the variant of the Lanczos method
320: to be used is one-sided or two-sided.
322: Logically Collective on SVD
324: Input Parameters:
325: + svd - singular value solver
326: - oneside - boolean flag indicating if the method is one-sided or not
328: Options Database Key:
329: . -svd_lanczos_oneside <boolean> - Indicates the boolean flag
331: Note:
332: By default, a two-sided variant is selected, which is sometimes slightly
333: more robust. However, the one-sided variant is faster because it avoids
334: the orthogonalization associated to left singular vectors. It also saves
335: the memory required for storing such vectors.
337: Level: advanced
339: .seealso: SVDTRLanczosSetOneSide()
340: @*/
341: PetscErrorCode SVDLanczosSetOneSide(SVD svd,PetscBool oneside)
342: {
348: PetscTryMethod(svd,"SVDLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
349: return(0);
350: }
354: static PetscErrorCode SVDLanczosGetOneSide_Lanczos(SVD svd,PetscBool *oneside)
355: {
356: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
359: *oneside = lanczos->oneside;
360: return(0);
361: }
365: /*@
366: SVDLanczosGetOneSide - Gets if the variant of the Lanczos method
367: to be used is one-sided or two-sided.
369: Not Collective
371: Input Parameters:
372: . svd - singular value solver
374: Output Parameters:
375: . oneside - boolean flag indicating if the method is one-sided or not
377: Level: advanced
379: .seealso: SVDLanczosSetOneSide()
380: @*/
381: PetscErrorCode SVDLanczosGetOneSide(SVD svd,PetscBool *oneside)
382: {
388: PetscUseMethod(svd,"SVDLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
389: return(0);
390: }
394: PetscErrorCode SVDDestroy_Lanczos(SVD svd)
395: {
399: PetscFree(svd->data);
400: PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosSetOneSide_C",NULL);
401: PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosGetOneSide_C",NULL);
402: return(0);
403: }
407: PetscErrorCode SVDView_Lanczos(SVD svd,PetscViewer viewer)
408: {
410: SVD_LANCZOS *lanczos = (SVD_LANCZOS*)svd->data;
411: PetscBool isascii;
414: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
415: if (isascii) {
416: PetscViewerASCIIPrintf(viewer," Lanczos: %s-sided reorthogonalization\n",lanczos->oneside? "one": "two");
417: }
418: return(0);
419: }
423: PETSC_EXTERN PetscErrorCode SVDCreate_Lanczos(SVD svd)
424: {
426: SVD_LANCZOS *ctx;
429: PetscNewLog(svd,&ctx);
430: svd->data = (void*)ctx;
432: svd->ops->setup = SVDSetUp_Lanczos;
433: svd->ops->solve = SVDSolve_Lanczos;
434: svd->ops->destroy = SVDDestroy_Lanczos;
435: svd->ops->setfromoptions = SVDSetFromOptions_Lanczos;
436: svd->ops->view = SVDView_Lanczos;
437: PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosSetOneSide_C",SVDLanczosSetOneSide_Lanczos);
438: PetscObjectComposeFunction((PetscObject)svd,"SVDLanczosGetOneSide_C",SVDLanczosGetOneSide_Lanczos);
439: return(0);
440: }