Actual source code: epskrylov.c
slepc-3.17.0 2022-03-31
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: Common subroutines for all Krylov-type solvers
12: */
14: #include <slepc/private/epsimpl.h>
15: #include <slepc/private/slepcimpl.h>
16: #include <slepcblaslapack.h>
18: /*
19: EPSDelayedArnoldi - This function is equivalent to BVMatArnoldi but
20: performs the computation in a different way. The main idea is that
21: reorthogonalization is delayed to the next Arnoldi step. This version is
22: more scalable but in some cases convergence may stagnate.
23: */
24: PetscErrorCode EPSDelayedArnoldi(EPS eps,PetscScalar *H,PetscInt ldh,PetscInt k,PetscInt *M,PetscReal *beta,PetscBool *breakdown)
25: {
26: PetscInt i,j,m=*M;
27: Vec u,t;
28: PetscScalar shh[100],*lhh,dot,dot2;
29: PetscReal norm1=0.0,norm2=1.0;
30: Vec vj,vj1,vj2=NULL;
32: if (m<=100) lhh = shh;
33: else PetscMalloc1(m,&lhh);
34: BVCreateVec(eps->V,&u);
35: BVCreateVec(eps->V,&t);
37: BVSetActiveColumns(eps->V,0,m);
38: for (j=k;j<m;j++) {
39: BVGetColumn(eps->V,j,&vj);
40: BVGetColumn(eps->V,j+1,&vj1);
41: STApply(eps->st,vj,vj1);
42: BVRestoreColumn(eps->V,j,&vj);
43: BVRestoreColumn(eps->V,j+1,&vj1);
45: BVDotColumnBegin(eps->V,j+1,H+ldh*j);
46: if (j>k) {
47: BVDotColumnBegin(eps->V,j,lhh);
48: BVGetColumn(eps->V,j,&vj);
49: VecDotBegin(vj,vj,&dot);
50: if (j>k+1) {
51: BVNormVecBegin(eps->V,u,NORM_2,&norm2);
52: BVGetColumn(eps->V,j-2,&vj2);
53: VecDotBegin(u,vj2,&dot2);
54: }
55: BVDotColumnEnd(eps->V,j+1,H+ldh*j);
56: BVDotColumnEnd(eps->V,j,lhh);
57: VecDotEnd(vj,vj,&dot);
58: BVRestoreColumn(eps->V,j,&vj);
59: if (j>k+1) {
60: BVNormVecEnd(eps->V,u,NORM_2,&norm2);
61: VecDotEnd(u,vj2,&dot2);
62: BVRestoreColumn(eps->V,j-2,&vj2);
63: }
64: norm1 = PetscSqrtReal(PetscRealPart(dot));
65: for (i=0;i<j;i++) H[ldh*j+i] = H[ldh*j+i]/norm1;
66: H[ldh*j+j] = H[ldh*j+j]/dot;
67: BVCopyVec(eps->V,j,t);
68: BVScaleColumn(eps->V,j,1.0/norm1);
69: BVScaleColumn(eps->V,j+1,1.0/norm1);
70: } else BVDotColumnEnd(eps->V,j+1,H+ldh*j); /* j==k */
72: BVMultColumn(eps->V,-1.0,1.0,j+1,H+ldh*j);
74: if (j>k) {
75: BVSetActiveColumns(eps->V,0,j);
76: BVMultVec(eps->V,-1.0,1.0,t,lhh);
77: BVSetActiveColumns(eps->V,0,m);
78: for (i=0;i<j;i++) H[ldh*(j-1)+i] += lhh[i];
79: }
81: if (j>k+1) {
82: BVGetColumn(eps->V,j-1,&vj1);
83: VecCopy(u,vj1);
84: BVRestoreColumn(eps->V,j-1,&vj1);
85: BVScaleColumn(eps->V,j-1,1.0/norm2);
86: H[ldh*(j-2)+j-1] = norm2;
87: }
89: if (j<m-1) VecCopy(t,u);
90: }
92: BVNormVec(eps->V,t,NORM_2,&norm2);
93: VecScale(t,1.0/norm2);
94: BVGetColumn(eps->V,m-1,&vj1);
95: VecCopy(t,vj1);
96: BVRestoreColumn(eps->V,m-1,&vj1);
97: H[ldh*(m-2)+m-1] = norm2;
99: BVDotColumn(eps->V,m,lhh);
101: BVMultColumn(eps->V,-1.0,1.0,m,lhh);
102: for (i=0;i<m;i++)
103: H[ldh*(m-1)+i] += lhh[i];
105: BVNormColumn(eps->V,m,NORM_2,beta);
106: BVScaleColumn(eps->V,m,1.0 / *beta);
107: *breakdown = PETSC_FALSE;
109: if (m>100) PetscFree(lhh);
110: VecDestroy(&u);
111: VecDestroy(&t);
112: PetscFunctionReturn(0);
113: }
115: /*
116: EPSDelayedArnoldi1 - This function is similar to EPSDelayedArnoldi,
117: but without reorthogonalization (only delayed normalization).
118: */
119: PetscErrorCode EPSDelayedArnoldi1(EPS eps,PetscScalar *H,PetscInt ldh,PetscInt k,PetscInt *M,PetscReal *beta,PetscBool *breakdown)
120: {
121: PetscInt i,j,m=*M;
122: PetscScalar dot;
123: PetscReal norm=0.0;
124: Vec vj,vj1;
126: BVSetActiveColumns(eps->V,0,m);
127: for (j=k;j<m;j++) {
128: BVGetColumn(eps->V,j,&vj);
129: BVGetColumn(eps->V,j+1,&vj1);
130: STApply(eps->st,vj,vj1);
131: BVRestoreColumn(eps->V,j+1,&vj1);
132: if (j>k) {
133: BVDotColumnBegin(eps->V,j+1,H+ldh*j);
134: VecDotBegin(vj,vj,&dot);
135: BVDotColumnEnd(eps->V,j+1,H+ldh*j);
136: VecDotEnd(vj,vj,&dot);
137: norm = PetscSqrtReal(PetscRealPart(dot));
138: BVScaleColumn(eps->V,j,1.0/norm);
139: H[ldh*(j-1)+j] = norm;
140: for (i=0;i<j;i++) H[ldh*j+i] = H[ldh*j+i]/norm;
141: H[ldh*j+j] = H[ldh*j+j]/dot;
142: BVScaleColumn(eps->V,j+1,1.0/norm);
143: *beta = norm;
144: } else { /* j==k */
145: BVDotColumn(eps->V,j+1,H+ldh*j);
146: }
147: BVRestoreColumn(eps->V,j,&vj);
148: BVMultColumn(eps->V,-1.0,1.0,j+1,H+ldh*j);
149: }
151: *breakdown = PETSC_FALSE;
152: PetscFunctionReturn(0);
153: }
155: /*
156: EPSKrylovConvergence_Filter - Specialized version for STFILTER.
157: */
158: PetscErrorCode EPSKrylovConvergence_Filter(EPS eps,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal beta,PetscReal gamma,PetscInt *kout)
159: {
160: PetscInt k,ninside,nconv;
161: PetscScalar re,im;
162: PetscReal resnorm;
164: ninside = 0; /* count how many eigenvalues are located in the interval */
165: for (k=kini;k<kini+nits;k++) {
166: if (PetscRealPart(eps->eigr[k]) < gamma) break;
167: ninside++;
168: }
169: eps->nev = ninside+kini; /* adjust eigenvalue count */
170: nconv = 0; /* count how many eigenvalues satisfy the convergence criterion */
171: for (k=kini;k<kini+ninside;k++) {
172: /* eigenvalue */
173: re = eps->eigr[k];
174: im = eps->eigi[k];
175: DSVectors(eps->ds,DS_MAT_X,&k,&resnorm);
176: resnorm *= beta;
177: /* error estimate */
178: (*eps->converged)(eps,re,im,resnorm,&eps->errest[k],eps->convergedctx);
179: if (eps->errest[k] < eps->tol) nconv++;
180: else break;
181: }
182: *kout = kini+nconv;
183: PetscInfo(eps,"Found %" PetscInt_FMT " eigenvalue approximations inside the interval (gamma=%g), k=%" PetscInt_FMT " nconv=%" PetscInt_FMT "\n",ninside,(double)gamma,k,nconv);
184: PetscFunctionReturn(0);
185: }
187: /*
188: EPSKrylovConvergence - Implements the loop that checks for convergence
189: in Krylov methods.
191: Input Parameters:
192: eps - the eigensolver; some error estimates are updated in eps->errest
193: getall - whether all residuals must be computed
194: kini - initial value of k (the loop variable)
195: nits - number of iterations of the loop
196: V - set of basis vectors (used only if trueresidual is activated)
197: nv - number of vectors to process (dimension of Q, columns of V)
198: beta - norm of f (the residual vector of the Arnoldi/Lanczos factorization)
199: corrf - correction factor for residual estimates (only in harmonic KS)
201: Output Parameters:
202: kout - the first index where the convergence test failed
203: */
204: PetscErrorCode EPSKrylovConvergence(EPS eps,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal beta,PetscReal betat,PetscReal corrf,PetscInt *kout)
205: {
206: PetscInt k,newk,newk2,marker,ld,inside;
207: PetscScalar re,im,*Zr,*Zi,*X;
208: PetscReal resnorm,gamma,lerrest;
209: PetscBool isshift,isfilter,refined,istrivial;
210: Vec x=NULL,y=NULL,w[3];
212: if (PetscUnlikely(eps->which == EPS_ALL)) {
213: PetscObjectTypeCompare((PetscObject)eps->st,STFILTER,&isfilter);
214: if (isfilter) {
215: STFilterGetThreshold(eps->st,&gamma);
216: EPSKrylovConvergence_Filter(eps,getall,kini,nits,beta,gamma,kout);
217: PetscFunctionReturn(0);
218: }
219: }
220: RGIsTrivial(eps->rg,&istrivial);
221: if (PetscUnlikely(eps->trueres)) {
222: BVCreateVec(eps->V,&x);
223: BVCreateVec(eps->V,&y);
224: BVCreateVec(eps->V,&w[0]);
225: BVCreateVec(eps->V,&w[2]);
226: #if !defined(PETSC_USE_COMPLEX)
227: BVCreateVec(eps->V,&w[1]);
228: #else
229: w[1] = NULL;
230: #endif
231: }
232: DSGetLeadingDimension(eps->ds,&ld);
233: DSGetRefined(eps->ds,&refined);
234: PetscObjectTypeCompare((PetscObject)eps->st,STSHIFT,&isshift);
235: marker = -1;
236: if (eps->trackall) getall = PETSC_TRUE;
237: for (k=kini;k<kini+nits;k++) {
238: /* eigenvalue */
239: re = eps->eigr[k];
240: im = eps->eigi[k];
241: if (!istrivial || eps->trueres || isshift || eps->conv==EPS_CONV_NORM) STBackTransform(eps->st,1,&re,&im);
242: if (PetscUnlikely(!istrivial)) {
243: RGCheckInside(eps->rg,1,&re,&im,&inside);
244: if (marker==-1 && inside<0) marker = k;
245: if (!(eps->trueres || isshift || eps->conv==EPS_CONV_NORM)) { /* make sure eps->converged below uses the right value */
246: re = eps->eigr[k];
247: im = eps->eigi[k];
248: }
249: }
250: newk = k;
251: DSVectors(eps->ds,DS_MAT_X,&newk,&resnorm);
252: if (PetscUnlikely(eps->trueres)) {
253: DSGetArray(eps->ds,DS_MAT_X,&X);
254: Zr = X+k*ld;
255: if (newk==k+1) Zi = X+newk*ld;
256: else Zi = NULL;
257: EPSComputeRitzVector(eps,Zr,Zi,eps->V,x,y);
258: DSRestoreArray(eps->ds,DS_MAT_X,&X);
259: EPSComputeResidualNorm_Private(eps,PETSC_FALSE,re,im,x,y,w,&resnorm);
260: }
261: else if (!refined) resnorm *= beta*corrf;
262: /* error estimate */
263: (*eps->converged)(eps,re,im,resnorm,&eps->errest[k],eps->convergedctx);
264: if (marker==-1 && eps->errest[k] >= eps->tol) marker = k;
265: if (PetscUnlikely(eps->twosided)) {
266: newk2 = k;
267: DSVectors(eps->ds,DS_MAT_Y,&newk2,&resnorm);
268: resnorm *= betat;
269: (*eps->converged)(eps,re,im,resnorm,&lerrest,eps->convergedctx);
270: eps->errest[k] = PetscMax(eps->errest[k],lerrest);
271: if (marker==-1 && lerrest >= eps->tol) marker = k;
272: }
273: if (PetscUnlikely(newk==k+1)) {
274: eps->errest[k+1] = eps->errest[k];
275: k++;
276: }
277: if (marker!=-1 && !getall) break;
278: }
279: if (marker!=-1) k = marker;
280: *kout = k;
281: if (PetscUnlikely(eps->trueres)) {
282: VecDestroy(&x);
283: VecDestroy(&y);
284: VecDestroy(&w[0]);
285: VecDestroy(&w[2]);
286: #if !defined(PETSC_USE_COMPLEX)
287: VecDestroy(&w[1]);
288: #endif
289: }
290: PetscFunctionReturn(0);
291: }
293: PetscErrorCode EPSPseudoLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscReal *omega,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscBool *symmlost,PetscReal *cos,Vec w)
294: {
295: PetscInt j,m = *M,i,ld,l;
296: Vec vj,vj1;
297: PetscScalar *hwork,lhwork[100];
298: PetscReal norm,norm1,norm2,t,sym=0.0,fro=0.0;
299: PetscBLASInt j_,one=1;
301: DSGetLeadingDimension(eps->ds,&ld);
302: DSGetDimensions(eps->ds,NULL,&l,NULL,NULL);
303: if (cos) *cos = 1.0;
304: if (m > 100) PetscMalloc1(m,&hwork);
305: else hwork = lhwork;
307: BVSetActiveColumns(eps->V,0,m);
308: for (j=k;j<m;j++) {
309: BVGetColumn(eps->V,j,&vj);
310: BVGetColumn(eps->V,j+1,&vj1);
311: STApply(eps->st,vj,vj1);
312: BVRestoreColumn(eps->V,j,&vj);
313: BVRestoreColumn(eps->V,j+1,&vj1);
314: BVOrthogonalizeColumn(eps->V,j+1,hwork,&norm,breakdown);
315: alpha[j] = PetscRealPart(hwork[j]);
316: beta[j] = PetscAbsReal(norm);
317: if (j==k) {
318: PetscReal *f;
320: DSGetArrayReal(eps->ds,DS_MAT_T,&f);
321: for (i=0;i<l;i++) hwork[i] = 0.0;
322: for (;i<j-1;i++) hwork[i] -= f[2*ld+i];
323: DSRestoreArrayReal(eps->ds,DS_MAT_T,&f);
324: }
325: hwork[j-1] -= beta[j-1];
326: PetscBLASIntCast(j,&j_);
327: sym = SlepcAbs(BLASnrm2_(&j_,hwork,&one),sym);
328: fro = SlepcAbs(fro,SlepcAbs(alpha[j],beta[j]));
329: if (j>0) fro = SlepcAbs(fro,beta[j-1]);
330: if (sym/fro>PetscMax(PETSC_SQRT_MACHINE_EPSILON,10*eps->tol)) { *symmlost = PETSC_TRUE; *M=j+1; break; }
331: omega[j+1] = (norm<0.0)? -1.0: 1.0;
332: BVScaleColumn(eps->V,j+1,1.0/norm);
333: /* */
334: if (cos) {
335: BVGetColumn(eps->V,j+1,&vj1);
336: VecNorm(vj1,NORM_2,&norm1);
337: BVApplyMatrix(eps->V,vj1,w);
338: BVRestoreColumn(eps->V,j+1,&vj1);
339: VecNorm(w,NORM_2,&norm2);
340: t = 1.0/(norm1*norm2);
341: if (*cos>t) *cos = t;
342: }
343: }
344: if (m > 100) PetscFree(hwork);
345: PetscFunctionReturn(0);
346: }