Actual source code: lanczos.c
slepc-3.18.2 2023-01-26
1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
6: This file is part of SLEPc.
7: SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9: */
10: /*
11: SLEPc eigensolver: "lanczos"
13: Method: Explicitly Restarted Symmetric/Hermitian Lanczos
15: Algorithm:
17: Lanczos method for symmetric (Hermitian) problems, with explicit
18: restart and deflation. Several reorthogonalization strategies can
19: be selected.
21: References:
23: [1] "Lanczos Methods in SLEPc", SLEPc Technical Report STR-5,
24: available at https://slepc.upv.es.
25: */
27: #include <slepc/private/epsimpl.h>
28: #include <slepcblaslapack.h>
30: typedef struct {
31: EPSLanczosReorthogType reorthog; /* user-provided reorthogonalization parameter */
32: PetscInt allocsize; /* number of columns of work BV's allocated at setup */
33: BV AV; /* work BV used in selective reorthogonalization */
34: } EPS_LANCZOS;
36: PetscErrorCode EPSSetUp_Lanczos(EPS eps)
37: {
38: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
39: BVOrthogRefineType refine;
40: BVOrthogBlockType btype;
41: PetscReal eta;
43: EPSCheckHermitianDefinite(eps);
44: EPSSetDimensions_Default(eps,eps->nev,&eps->ncv,&eps->mpd);
46: if (eps->max_it==PETSC_DEFAULT) eps->max_it = PetscMax(100,2*eps->n/eps->ncv);
47: if (!eps->which) EPSSetWhichEigenpairs_Default(eps);
49: EPSCheckUnsupported(eps,EPS_FEATURE_ARBITRARY | EPS_FEATURE_REGION | EPS_FEATURE_EXTRACTION);
50: EPSCheckIgnored(eps,EPS_FEATURE_BALANCE);
54: EPSAllocateSolution(eps,1);
55: EPS_SetInnerProduct(eps);
56: if (lanczos->reorthog != EPS_LANCZOS_REORTHOG_FULL) {
57: BVGetOrthogonalization(eps->V,NULL,&refine,&eta,&btype);
58: BVSetOrthogonalization(eps->V,BV_ORTHOG_MGS,refine,eta,btype);
59: PetscInfo(eps,"Switching to MGS orthogonalization\n");
60: }
61: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_SELECTIVE) {
62: if (!lanczos->allocsize) {
63: BVDuplicate(eps->V,&lanczos->AV);
64: BVGetSizes(lanczos->AV,NULL,NULL,&lanczos->allocsize);
65: } else { /* make sure V and AV have the same size */
66: BVGetSizes(eps->V,NULL,NULL,&lanczos->allocsize);
67: BVResize(lanczos->AV,lanczos->allocsize,PETSC_FALSE);
68: }
69: }
71: DSSetType(eps->ds,DSHEP);
72: DSSetCompact(eps->ds,PETSC_TRUE);
73: DSAllocate(eps->ds,eps->ncv+1);
74: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) EPSSetWorkVecs(eps,1);
75: return 0;
76: }
78: /*
79: EPSLocalLanczos - Local reorthogonalization.
81: This is the simplest variant. At each Lanczos step, the corresponding Lanczos vector
82: is orthogonalized with respect to the two previous Lanczos vectors, according to
83: the three term Lanczos recurrence. WARNING: This variant does not track the loss of
84: orthogonality that occurs in finite-precision arithmetic and, therefore, the
85: generated vectors are not guaranteed to be (semi-)orthogonal.
86: */
87: static PetscErrorCode EPSLocalLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown)
88: {
89: PetscInt i,j,m = *M;
90: Mat Op;
91: PetscBool *which,lwhich[100];
92: PetscScalar *hwork,lhwork[100];
94: if (m > 100) PetscMalloc2(m,&which,m,&hwork);
95: else {
96: which = lwhich;
97: hwork = lhwork;
98: }
99: for (i=0;i<k;i++) which[i] = PETSC_TRUE;
101: BVSetActiveColumns(eps->V,0,m);
102: STGetOperator(eps->st,&Op);
103: for (j=k;j<m;j++) {
104: BVMatMultColumn(eps->V,Op,j);
105: which[j] = PETSC_TRUE;
106: if (j-2>=k) which[j-2] = PETSC_FALSE;
107: BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,beta+j,breakdown);
108: alpha[j] = PetscRealPart(hwork[j]);
109: if (PetscUnlikely(*breakdown)) {
110: *M = j+1;
111: break;
112: } else BVScaleColumn(eps->V,j+1,1/beta[j]);
113: }
114: STRestoreOperator(eps->st,&Op);
115: if (m > 100) PetscFree2(which,hwork);
116: return 0;
117: }
119: /*
120: DenseTridiagonal - Solves a real tridiagonal Hermitian Eigenvalue Problem.
122: Input Parameters:
123: + n - dimension of the eigenproblem
124: . D - pointer to the array containing the diagonal elements
125: - E - pointer to the array containing the off-diagonal elements
127: Output Parameters:
128: + w - pointer to the array to store the computed eigenvalues
129: - V - pointer to the array to store the eigenvectors
131: Notes:
132: If V is NULL then the eigenvectors are not computed.
134: This routine use LAPACK routines xSTEVR.
135: */
136: static PetscErrorCode DenseTridiagonal(PetscInt n_,PetscReal *D,PetscReal *E,PetscReal *w,PetscScalar *V)
137: {
138: PetscReal abstol = 0.0,vl,vu,*work;
139: PetscBLASInt il,iu,m,*isuppz,n,lwork,*iwork,liwork,info;
140: const char *jobz;
141: #if defined(PETSC_USE_COMPLEX)
142: PetscInt i,j;
143: PetscReal *VV=NULL;
144: #endif
146: PetscBLASIntCast(n_,&n);
147: PetscBLASIntCast(20*n_,&lwork);
148: PetscBLASIntCast(10*n_,&liwork);
149: if (V) {
150: jobz = "V";
151: #if defined(PETSC_USE_COMPLEX)
152: PetscMalloc1(n*n,&VV);
153: #endif
154: } else jobz = "N";
155: PetscMalloc3(2*n,&isuppz,lwork,&work,liwork,&iwork);
156: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
157: #if defined(PETSC_USE_COMPLEX)
158: PetscCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,VV,&n,isuppz,work,&lwork,iwork,&liwork,&info));
159: #else
160: PetscCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info));
161: #endif
162: PetscFPTrapPop();
163: SlepcCheckLapackInfo("stevr",info);
164: #if defined(PETSC_USE_COMPLEX)
165: if (V) {
166: for (i=0;i<n;i++)
167: for (j=0;j<n;j++)
168: V[i*n+j] = VV[i*n+j];
169: PetscFree(VV);
170: }
171: #endif
172: PetscFree3(isuppz,work,iwork);
173: return 0;
174: }
176: /*
177: EPSSelectiveLanczos - Selective reorthogonalization.
178: */
179: static PetscErrorCode EPSSelectiveLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscReal anorm)
180: {
181: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
182: PetscInt i,j,m = *M,n,nritz=0,nritzo;
183: Vec vj1,av;
184: Mat Op;
185: PetscReal *d,*e,*ritz,norm;
186: PetscScalar *Y,*hwork;
187: PetscBool *which;
189: PetscCalloc6(m+1,&d,m,&e,m,&ritz,m*m,&Y,m,&which,m,&hwork);
190: for (i=0;i<k;i++) which[i] = PETSC_TRUE;
191: STGetOperator(eps->st,&Op);
193: for (j=k;j<m;j++) {
194: BVSetActiveColumns(eps->V,0,m);
196: /* Lanczos step */
197: BVMatMultColumn(eps->V,Op,j);
198: which[j] = PETSC_TRUE;
199: if (j-2>=k) which[j-2] = PETSC_FALSE;
200: BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,&norm,breakdown);
201: alpha[j] = PetscRealPart(hwork[j]);
202: beta[j] = norm;
203: if (PetscUnlikely(*breakdown)) {
204: *M = j+1;
205: break;
206: }
208: /* Compute eigenvalues and eigenvectors Y of the tridiagonal block */
209: n = j-k+1;
210: for (i=0;i<n;i++) {
211: d[i] = alpha[i+k];
212: e[i] = beta[i+k];
213: }
214: DenseTridiagonal(n,d,e,ritz,Y);
216: /* Estimate ||A|| */
217: for (i=0;i<n;i++)
218: if (PetscAbsReal(ritz[i]) > anorm) anorm = PetscAbsReal(ritz[i]);
220: /* Compute nearly converged Ritz vectors */
221: nritzo = 0;
222: for (i=0;i<n;i++) {
223: if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm) nritzo++;
224: }
225: if (nritzo>nritz) {
226: nritz = 0;
227: for (i=0;i<n;i++) {
228: if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm) {
229: BVSetActiveColumns(eps->V,k,k+n);
230: BVGetColumn(lanczos->AV,nritz,&av);
231: BVMultVec(eps->V,1.0,0.0,av,Y+i*n);
232: BVRestoreColumn(lanczos->AV,nritz,&av);
233: nritz++;
234: }
235: }
236: }
237: if (nritz > 0) {
238: BVGetColumn(eps->V,j+1,&vj1);
239: BVSetActiveColumns(lanczos->AV,0,nritz);
240: BVOrthogonalizeVec(lanczos->AV,vj1,hwork,&norm,breakdown);
241: BVRestoreColumn(eps->V,j+1,&vj1);
242: if (PetscUnlikely(*breakdown)) {
243: *M = j+1;
244: break;
245: }
246: }
247: BVScaleColumn(eps->V,j+1,1.0/norm);
248: }
250: STRestoreOperator(eps->st,&Op);
251: PetscFree6(d,e,ritz,Y,which,hwork);
252: return 0;
253: }
255: static void update_omega(PetscReal *omega,PetscReal *omega_old,PetscInt j,PetscReal *alpha,PetscReal *beta,PetscReal eps1,PetscReal anorm)
256: {
257: PetscInt k;
258: PetscReal T,binv;
260: /* Estimate of contribution to roundoff errors from A*v
261: fl(A*v) = A*v + f,
262: where ||f|| \approx eps1*||A||.
263: For a full matrix A, a rule-of-thumb estimate is eps1 = sqrt(n)*eps */
264: T = eps1*anorm;
265: binv = 1.0/beta[j+1];
267: /* Update omega(1) using omega(0)==0 */
268: omega_old[0]= beta[1]*omega[1] + (alpha[0]-alpha[j])*omega[0] - beta[j]*omega_old[0];
269: if (omega_old[0] > 0) omega_old[0] = binv*(omega_old[0] + T);
270: else omega_old[0] = binv*(omega_old[0] - T);
272: /* Update remaining components */
273: for (k=1;k<j-1;k++) {
274: omega_old[k] = beta[k+1]*omega[k+1] + (alpha[k]-alpha[j])*omega[k] + beta[k]*omega[k-1] - beta[j]*omega_old[k];
275: if (omega_old[k] > 0) omega_old[k] = binv*(omega_old[k] + T);
276: else omega_old[k] = binv*(omega_old[k] - T);
277: }
278: omega_old[j-1] = binv*T;
280: /* Swap omega and omega_old */
281: for (k=0;k<j;k++) {
282: omega[k] = omega_old[k];
283: omega_old[k] = omega[k];
284: }
285: omega[j] = eps1;
286: return;
287: }
289: static void compute_int(PetscBool *which,PetscReal *mu,PetscInt j,PetscReal delta,PetscReal eta)
290: {
291: PetscInt i,k,maxpos;
292: PetscReal max;
293: PetscBool found;
295: /* initialize which */
296: found = PETSC_FALSE;
297: maxpos = 0;
298: max = 0.0;
299: for (i=0;i<j;i++) {
300: if (PetscAbsReal(mu[i]) >= delta) {
301: which[i] = PETSC_TRUE;
302: found = PETSC_TRUE;
303: } else which[i] = PETSC_FALSE;
304: if (PetscAbsReal(mu[i]) > max) {
305: maxpos = i;
306: max = PetscAbsReal(mu[i]);
307: }
308: }
309: if (!found) which[maxpos] = PETSC_TRUE;
311: for (i=0;i<j;i++) {
312: if (which[i]) {
313: /* find left interval */
314: for (k=i;k>=0;k--) {
315: if (PetscAbsReal(mu[k])<eta || which[k]) break;
316: else which[k] = PETSC_TRUE;
317: }
318: /* find right interval */
319: for (k=i+1;k<j;k++) {
320: if (PetscAbsReal(mu[k])<eta || which[k]) break;
321: else which[k] = PETSC_TRUE;
322: }
323: }
324: }
325: return;
326: }
328: /*
329: EPSPartialLanczos - Partial reorthogonalization.
330: */
331: static PetscErrorCode EPSPartialLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscReal anorm)
332: {
333: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
334: PetscInt i,j,m = *M;
335: Mat Op;
336: PetscReal norm,*omega,lomega[100],*omega_old,lomega_old[100],eps1,delta,eta;
337: PetscBool *which,lwhich[100],*which2,lwhich2[100];
338: PetscBool reorth = PETSC_FALSE,force_reorth = PETSC_FALSE;
339: PetscBool fro = PETSC_FALSE,estimate_anorm = PETSC_FALSE;
340: PetscScalar *hwork,lhwork[100];
342: if (m>100) PetscMalloc5(m,&omega,m,&omega_old,m,&which,m,&which2,m,&hwork);
343: else {
344: omega = lomega;
345: omega_old = lomega_old;
346: which = lwhich;
347: which2 = lwhich2;
348: hwork = lhwork;
349: }
351: eps1 = PetscSqrtReal((PetscReal)eps->n)*PETSC_MACHINE_EPSILON/2;
352: delta = PETSC_SQRT_MACHINE_EPSILON/PetscSqrtReal((PetscReal)eps->ncv);
353: eta = PetscPowReal(PETSC_MACHINE_EPSILON,3.0/4.0)/PetscSqrtReal((PetscReal)eps->ncv);
354: if (anorm < 0.0) {
355: anorm = 1.0;
356: estimate_anorm = PETSC_TRUE;
357: }
358: for (i=0;i<PetscMax(100,m);i++) omega[i] = omega_old[i] = 0.0;
359: for (i=0;i<k;i++) which[i] = PETSC_TRUE;
361: BVSetActiveColumns(eps->V,0,m);
362: STGetOperator(eps->st,&Op);
363: for (j=k;j<m;j++) {
364: BVMatMultColumn(eps->V,Op,j);
365: if (fro) {
366: /* Lanczos step with full reorthogonalization */
367: BVOrthogonalizeColumn(eps->V,j+1,hwork,&norm,breakdown);
368: alpha[j] = PetscRealPart(hwork[j]);
369: } else {
370: /* Lanczos step */
371: which[j] = PETSC_TRUE;
372: if (j-2>=k) which[j-2] = PETSC_FALSE;
373: BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,&norm,breakdown);
374: alpha[j] = PetscRealPart(hwork[j]);
375: beta[j] = norm;
377: /* Estimate ||A|| if needed */
378: if (estimate_anorm) {
379: if (j>k) anorm = PetscMax(anorm,PetscAbsReal(alpha[j])+norm+beta[j-1]);
380: else anorm = PetscMax(anorm,PetscAbsReal(alpha[j])+norm);
381: }
383: /* Check if reorthogonalization is needed */
384: reorth = PETSC_FALSE;
385: if (j>k) {
386: update_omega(omega,omega_old,j,alpha,beta-1,eps1,anorm);
387: for (i=0;i<j-k;i++) {
388: if (PetscAbsReal(omega[i]) > delta) reorth = PETSC_TRUE;
389: }
390: }
391: if (reorth || force_reorth) {
392: for (i=0;i<k;i++) which2[i] = PETSC_FALSE;
393: for (i=k;i<=j;i++) which2[i] = PETSC_TRUE;
394: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_PERIODIC) {
395: /* Periodic reorthogonalization */
396: if (force_reorth) force_reorth = PETSC_FALSE;
397: else force_reorth = PETSC_TRUE;
398: for (i=0;i<j-k;i++) omega[i] = eps1;
399: } else {
400: /* Partial reorthogonalization */
401: if (force_reorth) force_reorth = PETSC_FALSE;
402: else {
403: force_reorth = PETSC_TRUE;
404: compute_int(which2+k,omega,j-k,delta,eta);
405: for (i=0;i<j-k;i++) {
406: if (which2[i+k]) omega[i] = eps1;
407: }
408: }
409: }
410: BVOrthogonalizeSomeColumn(eps->V,j+1,which2,hwork,&norm,breakdown);
411: }
412: }
414: if (PetscUnlikely(*breakdown || norm < eps->n*anorm*PETSC_MACHINE_EPSILON)) {
415: *M = j+1;
416: break;
417: }
418: if (!fro && norm*delta < anorm*eps1) {
419: fro = PETSC_TRUE;
420: PetscInfo(eps,"Switching to full reorthogonalization at iteration %" PetscInt_FMT "\n",eps->its);
421: }
422: beta[j] = norm;
423: BVScaleColumn(eps->V,j+1,1.0/norm);
424: }
426: STRestoreOperator(eps->st,&Op);
427: if (m>100) PetscFree5(omega,omega_old,which,which2,hwork);
428: return 0;
429: }
431: /*
432: EPSBasicLanczos - Computes an m-step Lanczos factorization. The first k
433: columns are assumed to be locked and therefore they are not modified. On
434: exit, the following relation is satisfied:
436: OP * V - V * T = f * e_m^T
438: where the columns of V are the Lanczos vectors, T is a tridiagonal matrix,
439: f is the residual vector and e_m is the m-th vector of the canonical basis.
440: The Lanczos vectors (together with vector f) are B-orthogonal (to working
441: accuracy) if full reorthogonalization is being used, otherwise they are
442: (B-)semi-orthogonal. On exit, beta contains the B-norm of f and the next
443: Lanczos vector can be computed as v_{m+1} = f / beta.
445: This function simply calls another function which depends on the selected
446: reorthogonalization strategy.
447: */
448: static PetscErrorCode EPSBasicLanczos(EPS eps,PetscInt k,PetscInt *m,PetscReal *betam,PetscBool *breakdown,PetscReal anorm)
449: {
450: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
451: PetscScalar *T;
452: PetscInt i,n=*m,ld;
453: PetscReal *alpha,*beta;
454: BVOrthogRefineType orthog_ref;
455: Mat Op,M;
457: DSGetLeadingDimension(eps->ds,&ld);
458: switch (lanczos->reorthog) {
459: case EPS_LANCZOS_REORTHOG_LOCAL:
460: DSGetArrayReal(eps->ds,DS_MAT_T,&alpha);
461: beta = alpha + ld;
462: EPSLocalLanczos(eps,alpha,beta,k,m,breakdown);
463: *betam = beta[*m-1];
464: DSRestoreArrayReal(eps->ds,DS_MAT_T,&alpha);
465: break;
466: case EPS_LANCZOS_REORTHOG_FULL:
467: STGetOperator(eps->st,&Op);
468: DSGetMat(eps->ds,DS_MAT_T,&M);
469: BVMatLanczos(eps->V,Op,M,k,m,betam,breakdown);
470: DSRestoreMat(eps->ds,DS_MAT_T,&M);
471: STRestoreOperator(eps->st,&Op);
472: break;
473: case EPS_LANCZOS_REORTHOG_SELECTIVE:
474: DSGetArrayReal(eps->ds,DS_MAT_T,&alpha);
475: beta = alpha + ld;
476: EPSSelectiveLanczos(eps,alpha,beta,k,m,breakdown,anorm);
477: *betam = beta[*m-1];
478: DSRestoreArrayReal(eps->ds,DS_MAT_T,&alpha);
479: break;
480: case EPS_LANCZOS_REORTHOG_PERIODIC:
481: case EPS_LANCZOS_REORTHOG_PARTIAL:
482: DSGetArrayReal(eps->ds,DS_MAT_T,&alpha);
483: beta = alpha + ld;
484: EPSPartialLanczos(eps,alpha,beta,k,m,breakdown,anorm);
485: *betam = beta[*m-1];
486: DSRestoreArrayReal(eps->ds,DS_MAT_T,&alpha);
487: break;
488: case EPS_LANCZOS_REORTHOG_DELAYED:
489: PetscMalloc1(n*n,&T);
490: BVGetOrthogonalization(eps->V,NULL,&orthog_ref,NULL,NULL);
491: if (orthog_ref == BV_ORTHOG_REFINE_NEVER) EPSDelayedArnoldi1(eps,T,n,k,m,betam,breakdown);
492: else EPSDelayedArnoldi(eps,T,n,k,m,betam,breakdown);
493: n = *m;
494: DSGetArrayReal(eps->ds,DS_MAT_T,&alpha);
495: beta = alpha + ld;
496: for (i=k;i<n-1;i++) {
497: alpha[i] = PetscRealPart(T[n*i+i]);
498: beta[i] = PetscRealPart(T[n*i+i+1]);
499: }
500: alpha[n-1] = PetscRealPart(T[n*(n-1)+n-1]);
501: beta[n-1] = *betam;
502: DSRestoreArrayReal(eps->ds,DS_MAT_T,&alpha);
503: PetscFree(T);
504: break;
505: }
506: return 0;
507: }
509: PetscErrorCode EPSSolve_Lanczos(EPS eps)
510: {
511: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
512: PetscInt nconv,i,j,k,l,x,n,*perm,restart,ncv=eps->ncv,r,ld;
513: Vec vi,vj,w;
514: Mat U;
515: PetscScalar *Y,*ritz,stmp;
516: PetscReal *bnd,anorm,beta,norm,rtmp,resnorm;
517: PetscBool breakdown;
518: char *conv,ctmp;
520: DSGetLeadingDimension(eps->ds,&ld);
521: PetscMalloc4(ncv,&ritz,ncv,&bnd,ncv,&perm,ncv,&conv);
523: /* The first Lanczos vector is the normalized initial vector */
524: EPSGetStartVector(eps,0,NULL);
526: anorm = -1.0;
527: nconv = 0;
529: /* Restart loop */
530: while (eps->reason == EPS_CONVERGED_ITERATING) {
531: eps->its++;
533: /* Compute an ncv-step Lanczos factorization */
534: n = PetscMin(nconv+eps->mpd,ncv);
535: DSSetDimensions(eps->ds,n,nconv,PETSC_DEFAULT);
536: EPSBasicLanczos(eps,nconv,&n,&beta,&breakdown,anorm);
537: DSSetDimensions(eps->ds,n,nconv,0);
538: DSSetState(eps->ds,DS_STATE_INTERMEDIATE);
539: BVSetActiveColumns(eps->V,nconv,n);
541: /* Solve projected problem */
542: DSSolve(eps->ds,ritz,NULL);
543: DSSort(eps->ds,ritz,NULL,NULL,NULL,NULL);
544: DSSynchronize(eps->ds,ritz,NULL);
546: /* Estimate ||A|| */
547: for (i=nconv;i<n;i++)
548: anorm = PetscMax(anorm,PetscAbsReal(PetscRealPart(ritz[i])));
550: /* Compute residual norm estimates as beta*abs(Y(m,:)) + eps*||A|| */
551: DSGetArray(eps->ds,DS_MAT_Q,&Y);
552: for (i=nconv;i<n;i++) {
553: resnorm = beta*PetscAbsScalar(Y[n-1+i*ld]) + PETSC_MACHINE_EPSILON*anorm;
554: (*eps->converged)(eps,ritz[i],eps->eigi[i],resnorm,&bnd[i],eps->convergedctx);
555: if (bnd[i]<eps->tol) conv[i] = 'C';
556: else conv[i] = 'N';
557: }
558: DSRestoreArray(eps->ds,DS_MAT_Q,&Y);
560: /* purge repeated ritz values */
561: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
562: for (i=nconv+1;i<n;i++) {
563: if (conv[i] == 'C' && PetscAbsScalar((ritz[i]-ritz[i-1])/ritz[i]) < eps->tol) conv[i] = 'R';
564: }
565: }
567: /* Compute restart vector */
568: if (breakdown) PetscInfo(eps,"Breakdown in Lanczos method (it=%" PetscInt_FMT " norm=%g)\n",eps->its,(double)beta);
569: else {
570: restart = nconv;
571: while (restart<n && conv[restart] != 'N') restart++;
572: if (restart >= n) {
573: breakdown = PETSC_TRUE;
574: } else {
575: for (i=restart+1;i<n;i++) {
576: if (conv[i] == 'N') {
577: SlepcSCCompare(eps->sc,ritz[restart],0.0,ritz[i],0.0,&r);
578: if (r>0) restart = i;
579: }
580: }
581: DSGetArray(eps->ds,DS_MAT_Q,&Y);
582: BVMultColumn(eps->V,1.0,0.0,n,Y+restart*ld+nconv);
583: DSRestoreArray(eps->ds,DS_MAT_Q,&Y);
584: }
585: }
587: /* Count and put converged eigenvalues first */
588: for (i=nconv;i<n;i++) perm[i] = i;
589: for (k=nconv;k<n;k++) {
590: if (conv[perm[k]] != 'C') {
591: j = k + 1;
592: while (j<n && conv[perm[j]] != 'C') j++;
593: if (j>=n) break;
594: l = perm[k]; perm[k] = perm[j]; perm[j] = l;
595: }
596: }
598: /* Sort eigenvectors according to permutation */
599: DSGetArray(eps->ds,DS_MAT_Q,&Y);
600: for (i=nconv;i<k;i++) {
601: x = perm[i];
602: if (x != i) {
603: j = i + 1;
604: while (perm[j] != i) j++;
605: /* swap eigenvalues i and j */
606: stmp = ritz[x]; ritz[x] = ritz[i]; ritz[i] = stmp;
607: rtmp = bnd[x]; bnd[x] = bnd[i]; bnd[i] = rtmp;
608: ctmp = conv[x]; conv[x] = conv[i]; conv[i] = ctmp;
609: perm[j] = x; perm[i] = i;
610: /* swap eigenvectors i and j */
611: for (l=0;l<n;l++) {
612: stmp = Y[l+x*ld]; Y[l+x*ld] = Y[l+i*ld]; Y[l+i*ld] = stmp;
613: }
614: }
615: }
616: DSRestoreArray(eps->ds,DS_MAT_Q,&Y);
618: /* compute converged eigenvectors */
619: DSGetMat(eps->ds,DS_MAT_Q,&U);
620: BVMultInPlace(eps->V,U,nconv,k);
621: DSRestoreMat(eps->ds,DS_MAT_Q,&U);
623: /* purge spurious ritz values */
624: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
625: for (i=nconv;i<k;i++) {
626: BVGetColumn(eps->V,i,&vi);
627: VecNorm(vi,NORM_2,&norm);
628: VecScale(vi,1.0/norm);
629: w = eps->work[0];
630: STApply(eps->st,vi,w);
631: VecAXPY(w,-ritz[i],vi);
632: BVRestoreColumn(eps->V,i,&vi);
633: VecNorm(w,NORM_2,&norm);
634: (*eps->converged)(eps,ritz[i],eps->eigi[i],norm,&bnd[i],eps->convergedctx);
635: if (bnd[i]>=eps->tol) conv[i] = 'S';
636: }
637: for (i=nconv;i<k;i++) {
638: if (conv[i] != 'C') {
639: j = i + 1;
640: while (j<k && conv[j] != 'C') j++;
641: if (j>=k) break;
642: /* swap eigenvalues i and j */
643: stmp = ritz[j]; ritz[j] = ritz[i]; ritz[i] = stmp;
644: rtmp = bnd[j]; bnd[j] = bnd[i]; bnd[i] = rtmp;
645: ctmp = conv[j]; conv[j] = conv[i]; conv[i] = ctmp;
646: /* swap eigenvectors i and j */
647: BVGetColumn(eps->V,i,&vi);
648: BVGetColumn(eps->V,j,&vj);
649: VecSwap(vi,vj);
650: BVRestoreColumn(eps->V,i,&vi);
651: BVRestoreColumn(eps->V,j,&vj);
652: }
653: }
654: k = i;
655: }
657: /* store ritz values and estimated errors */
658: for (i=nconv;i<n;i++) {
659: eps->eigr[i] = ritz[i];
660: eps->errest[i] = bnd[i];
661: }
662: nconv = k;
663: EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,n);
664: (*eps->stopping)(eps,eps->its,eps->max_it,nconv,eps->nev,&eps->reason,eps->stoppingctx);
666: if (eps->reason == EPS_CONVERGED_ITERATING) { /* copy restart vector */
667: BVCopyColumn(eps->V,n,nconv);
668: if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL && !breakdown) {
669: /* Reorthonormalize restart vector */
670: BVOrthonormalizeColumn(eps->V,nconv,PETSC_FALSE,NULL,&breakdown);
671: }
672: if (breakdown) {
673: /* Use random vector for restarting */
674: PetscInfo(eps,"Using random vector for restart\n");
675: EPSGetStartVector(eps,nconv,&breakdown);
676: }
677: if (PetscUnlikely(breakdown)) { /* give up */
678: eps->reason = EPS_DIVERGED_BREAKDOWN;
679: PetscInfo(eps,"Unable to generate more start vectors\n");
680: }
681: }
682: }
683: eps->nconv = nconv;
685: PetscFree4(ritz,bnd,perm,conv);
686: return 0;
687: }
689: PetscErrorCode EPSSetFromOptions_Lanczos(EPS eps,PetscOptionItems *PetscOptionsObject)
690: {
691: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
692: PetscBool flg;
693: EPSLanczosReorthogType reorthog=EPS_LANCZOS_REORTHOG_LOCAL,curval;
695: PetscOptionsHeadBegin(PetscOptionsObject,"EPS Lanczos Options");
697: curval = (lanczos->reorthog==(EPSLanczosReorthogType)-1)? EPS_LANCZOS_REORTHOG_LOCAL: lanczos->reorthog;
698: PetscOptionsEnum("-eps_lanczos_reorthog","Lanczos reorthogonalization","EPSLanczosSetReorthog",EPSLanczosReorthogTypes,(PetscEnum)curval,(PetscEnum*)&reorthog,&flg);
699: if (flg) EPSLanczosSetReorthog(eps,reorthog);
701: PetscOptionsHeadEnd();
702: return 0;
703: }
705: static PetscErrorCode EPSLanczosSetReorthog_Lanczos(EPS eps,EPSLanczosReorthogType reorthog)
706: {
707: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
709: switch (reorthog) {
710: case EPS_LANCZOS_REORTHOG_LOCAL:
711: case EPS_LANCZOS_REORTHOG_FULL:
712: case EPS_LANCZOS_REORTHOG_DELAYED:
713: case EPS_LANCZOS_REORTHOG_SELECTIVE:
714: case EPS_LANCZOS_REORTHOG_PERIODIC:
715: case EPS_LANCZOS_REORTHOG_PARTIAL:
716: if (lanczos->reorthog != reorthog) {
717: lanczos->reorthog = reorthog;
718: eps->state = EPS_STATE_INITIAL;
719: }
720: break;
721: default:
722: SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"Invalid reorthogonalization type");
723: }
724: return 0;
725: }
727: /*@
728: EPSLanczosSetReorthog - Sets the type of reorthogonalization used during the Lanczos
729: iteration.
731: Logically Collective on eps
733: Input Parameters:
734: + eps - the eigenproblem solver context
735: - reorthog - the type of reorthogonalization
737: Options Database Key:
738: . -eps_lanczos_reorthog - Sets the reorthogonalization type (either 'local', 'selective',
739: 'periodic', 'partial', 'full' or 'delayed')
741: Level: advanced
743: .seealso: EPSLanczosGetReorthog(), EPSLanczosReorthogType
744: @*/
745: PetscErrorCode EPSLanczosSetReorthog(EPS eps,EPSLanczosReorthogType reorthog)
746: {
749: PetscTryMethod(eps,"EPSLanczosSetReorthog_C",(EPS,EPSLanczosReorthogType),(eps,reorthog));
750: return 0;
751: }
753: static PetscErrorCode EPSLanczosGetReorthog_Lanczos(EPS eps,EPSLanczosReorthogType *reorthog)
754: {
755: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
757: *reorthog = lanczos->reorthog;
758: return 0;
759: }
761: /*@
762: EPSLanczosGetReorthog - Gets the type of reorthogonalization used during
763: the Lanczos iteration.
765: Not Collective
767: Input Parameter:
768: . eps - the eigenproblem solver context
770: Output Parameter:
771: . reorthog - the type of reorthogonalization
773: Level: advanced
775: .seealso: EPSLanczosSetReorthog(), EPSLanczosReorthogType
776: @*/
777: PetscErrorCode EPSLanczosGetReorthog(EPS eps,EPSLanczosReorthogType *reorthog)
778: {
781: PetscUseMethod(eps,"EPSLanczosGetReorthog_C",(EPS,EPSLanczosReorthogType*),(eps,reorthog));
782: return 0;
783: }
785: PetscErrorCode EPSReset_Lanczos(EPS eps)
786: {
787: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
789: BVDestroy(&lanczos->AV);
790: lanczos->allocsize = 0;
791: return 0;
792: }
794: PetscErrorCode EPSDestroy_Lanczos(EPS eps)
795: {
796: PetscFree(eps->data);
797: PetscObjectComposeFunction((PetscObject)eps,"EPSLanczosSetReorthog_C",NULL);
798: PetscObjectComposeFunction((PetscObject)eps,"EPSLanczosGetReorthog_C",NULL);
799: return 0;
800: }
802: PetscErrorCode EPSView_Lanczos(EPS eps,PetscViewer viewer)
803: {
804: EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
805: PetscBool isascii;
807: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
808: if (isascii) {
809: if (lanczos->reorthog != (EPSLanczosReorthogType)-1) PetscViewerASCIIPrintf(viewer," %s reorthogonalization\n",EPSLanczosReorthogTypes[lanczos->reorthog]);
810: }
811: return 0;
812: }
814: SLEPC_EXTERN PetscErrorCode EPSCreate_Lanczos(EPS eps)
815: {
816: EPS_LANCZOS *ctx;
818: PetscNew(&ctx);
819: eps->data = (void*)ctx;
820: ctx->reorthog = (EPSLanczosReorthogType)-1;
822: eps->useds = PETSC_TRUE;
824: eps->ops->solve = EPSSolve_Lanczos;
825: eps->ops->setup = EPSSetUp_Lanczos;
826: eps->ops->setupsort = EPSSetUpSort_Default;
827: eps->ops->setfromoptions = EPSSetFromOptions_Lanczos;
828: eps->ops->destroy = EPSDestroy_Lanczos;
829: eps->ops->reset = EPSReset_Lanczos;
830: eps->ops->view = EPSView_Lanczos;
831: eps->ops->backtransform = EPSBackTransform_Default;
832: eps->ops->computevectors = EPSComputeVectors_Hermitian;
834: PetscObjectComposeFunction((PetscObject)eps,"EPSLanczosSetReorthog_C",EPSLanczosSetReorthog_Lanczos);
835: PetscObjectComposeFunction((PetscObject)eps,"EPSLanczosGetReorthog_C",EPSLanczosGetReorthog_Lanczos);
836: return 0;
837: }