Actual source code: subspace.c
1: /*
3: SLEPc eigensolver: "subspace"
5: Method: Subspace Iteration
7: Algorithm:
9: Subspace iteration with Rayleigh-Ritz projection and locking,
10: based on the SRRIT implementation.
12: References:
14: [1] "Subspace Iteration in SLEPc", SLEPc Technical Report STR-3,
15: available at http://www.grycap.upv.es/slepc.
17: Last update: June 2004
19: */
20: #include src/eps/epsimpl.h
21: #include slepcblaslapack.h
25: PetscErrorCode EPSSetUp_SUBSPACE(EPS eps)
26: {
28: PetscInt N;
31: VecGetSize(eps->vec_initial,&N);
32: if (eps->ncv) {
33: if (eps->ncv<eps->nev) SETERRQ(1,"The value of ncv must be at least nev");
34: }
35: else eps->ncv = PetscMin(N,PetscMax(2*eps->nev,eps->nev+15));
36: if (!eps->max_it) eps->max_it = PetscMax(100,2*N/eps->ncv);
37: if (eps->which!=EPS_LARGEST_MAGNITUDE)
38: SETERRQ(1,"Wrong value of eps->which");
39: EPSAllocateSolution(eps);
40: PetscFree(eps->T);
41: PetscMalloc(eps->ncv*eps->ncv*sizeof(PetscScalar),&eps->T);
42: EPSDefaultGetWork(eps,eps->ncv);
43: return(0);
44: }
48: /*
49: EPSHessCond - Compute the inf-norm condition number of the upper
50: Hessenberg matrix H: cond(H) = norm(H)*norm(inv(H)).
51: This routine uses Gaussian elimination with partial pivoting to
52: compute the inverse explicitly.
53: */
54: static PetscErrorCode EPSHessCond(PetscScalar* H,int n, PetscReal* cond)
55: {
56: #if defined(PETSC_MISSING_LAPACK_GETRF) || defined(SLEPC_MISSING_LAPACK_GETRI) || defined(SLEPC_MISSING_LAPACK_LANGE) || defined(SLEPC_MISSING_LAPACK_LANHS)
58: SETERRQ(PETSC_ERR_SUP,"GETRF,GETRI - Lapack routines are unavailable.");
59: #else
61: int *ipiv,lwork,info;
62: PetscScalar *work;
63: PetscReal hn,hin,*rwork;
64:
66: PetscMalloc(sizeof(int)*n,&ipiv);
67: lwork = n*n;
68: PetscMalloc(sizeof(PetscScalar)*lwork,&work);
69: PetscMalloc(sizeof(PetscReal)*n,&rwork);
70: hn = LAPACKlanhs_("I",&n,H,&n,rwork,1);
71: LAPACKgetrf_(&n,&n,H,&n,ipiv,&info);
72: if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGETRF %d",info);
73: LAPACKgetri_(&n,H,&n,ipiv,work,&lwork,&info);
74: if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGETRI %d",info);
75: hin = LAPACKlange_("I",&n,&n,H,&n,rwork,1);
76: *cond = hn * hin;
77: PetscFree(ipiv);
78: PetscFree(work);
79: PetscFree(rwork);
80: return(0);
81: #endif
82: }
86: /*
87: EPSFindGroup - Find a group of nearly equimodular eigenvalues, provided
88: in arrays wr and wi, according to the tolerance grptol. Also the 2-norms
89: of the residuals must be passed-in (rsd). Arrays are processed from index
90: l to index m only. The output information is:
92: ngrp - number of entries of the group
93: ctr - (w(l)+w(l+ngrp-1))/2
94: ae - average of wr(l),...,wr(l+ngrp-1)
95: arsd - average of rsd(l),...,rsd(l+ngrp-1)
96: */
97: static PetscErrorCode EPSFindGroup(int l,int m,PetscScalar *wr,PetscScalar *wi,PetscReal *rsd,
98: PetscReal grptol,int *ngrp,PetscReal *ctr,PetscReal *ae,PetscReal *arsd)
99: {
100: int i;
101: PetscReal rmod,rmod1;
104: *ngrp = 0;
105: *ctr = 0;
106:
107: rmod = SlepcAbsEigenvalue(wr[l],wi[l]);
109: for (i=l;i<m;) {
110: rmod1 = SlepcAbsEigenvalue(wr[i],wi[i]);
111: if (PetscAbsReal(rmod-rmod1) > grptol*(rmod+rmod1)) break;
112: *ctr = (rmod+rmod1)/2.0;
113: if (wi[i] != 0.0) {
114: (*ngrp)+=2;
115: i+=2;
116: } else {
117: (*ngrp)++;
118: i++;
119: }
120: }
122: *ae = 0;
123: *arsd = 0;
125: if (*ngrp) {
126: for (i=l;i<l+*ngrp;i++) {
127: (*ae) += PetscRealPart(wr[i]);
128: (*arsd) += rsd[i]*rsd[i];
129: }
130: *ae = *ae / *ngrp;
131: *arsd = PetscSqrtScalar(*arsd / *ngrp);
132: }
133: return(0);
134: }
138: /*
139: EPSSchurResidualNorms - Computes the column norms of residual vectors
140: OP*V(1:n,l:m) - V*T(1:m,l:m) were on entry, OP*V has been computed and
141: stored in AV. ldt is the leading dimension of T. On exit, rsd(l) to
142: rsd(m) contain the computed norms.
143: */
144: static PetscErrorCode EPSSchurResidualNorms(EPS eps,Vec *V,Vec *AV,PetscScalar *T,int l,int m,int ldt,PetscReal *rsd)
145: {
147: int i;
148: #if defined(PETSC_USE_COMPLEX)
149: PetscScalar t;
150: #endif
153: for (i=l;i<m;i++) {
154: VecSet(eps->work[0],0.0);
155: VecMAXPY(eps->work[0],m,T+ldt*i,V);
156: VecWAXPY(eps->work[1],-1.0,eps->work[0],AV[i]);
157: #if !defined(PETSC_USE_COMPLEX)
158: VecDot(eps->work[1],eps->work[1],rsd+i);
159: #else
160: VecDot(eps->work[1],eps->work[1],&t);
161: rsd[i] = PetscRealPart(t);
162: #endif
163: }
165: for (i=l;i<m;i++) {
166: if (i == m-1) {
167: rsd[i] = sqrt(rsd[i]);
168: } else if (T[i+1+(ldt*i)]==0.0) {
169: rsd[i] = sqrt(rsd[i]);
170: } else {
171: rsd[i] = sqrt(rsd[i]+rsd[i+1])/2.0;
172: rsd[i+1] = rsd[i];
173: i++;
174: }
175: }
176: return(0);
177: }
181: PetscErrorCode EPSSolve_SUBSPACE(EPS eps)
182: {
184: int i,ngrp,nogrp,*itrsd,*itrsdold,
185: nxtsrr,idsrr,idort,nxtort,ncv = eps->ncv,its;
186: PetscScalar *T=eps->T,*U;
187: PetscReal arsd,oarsd,ctr,octr,ae,oae,*rsd,*rsdold,norm,tcond;
188: PetscTruth breakdown;
189: /* Parameters */
190: int init = 5; /* Number of initial iterations */
191: PetscReal stpfac = 1.5, /* Max num of iter before next SRR step */
192: alpha = 1.0, /* Used to predict convergence of next residual */
193: beta = 1.1, /* Used to predict convergence of next residual */
194: grptol = 1e-8, /* Tolerance for EPSFindGroup */
195: cnvtol = 1e-6; /* Convergence criterion for cnv */
196: int orttol = 2; /* Number of decimal digits whose loss
197: can be tolerated in orthogonalization */
200: its = 0;
201: PetscMalloc(sizeof(PetscScalar)*ncv*ncv,&U);
202: PetscMalloc(sizeof(PetscReal)*ncv,&rsd);
203: PetscMalloc(sizeof(PetscReal)*ncv,&rsdold);
204: PetscMalloc(sizeof(int)*ncv,&itrsd);
205: PetscMalloc(sizeof(int)*ncv,&itrsdold);
207: /* Generate a set of random initial vectors and orthonormalize them */
208: for (i=0;i<ncv;i++) {
209: SlepcVecSetRandom(eps->V[i]);
210: rsd[i] = 0.0;
211: itrsd[i] = -1;
212: }
213: EPSQRDecomposition(eps,eps->V,0,ncv,PETSC_NULL,0);
214:
215: while (eps->its<eps->max_it) {
216: eps->its++;
217:
218: /* Find group in previously computed eigenvalues */
219: EPSFindGroup(eps->nconv,ncv,eps->eigr,eps->eigi,rsd,grptol,&nogrp,&octr,&oae,&oarsd);
221: /* Compute a Rayleigh-Ritz projection step
222: on the active columns (idx) */
224: /* 1. AV(:,idx) = OP * V(:,idx) */
225: for (i=eps->nconv;i<ncv;i++) {
226: STApply(eps->OP,eps->V[i],eps->AV[i]);
227: }
229: /* 2. T(:,idx) = V' * AV(:,idx) */
230: for (i=eps->nconv;i<ncv;i++) {
231: VecMDot(eps->AV[i],ncv,eps->V,T+i*ncv);
232: }
234: /* 3. Reduce projected matrix to Hessenberg form: [U,T] = hess(T) */
235: EPSDenseHessenberg(ncv,eps->nconv,T,ncv,U);
236:
237: /* 4. Reduce T to quasi-triangular (Schur) form */
238: EPSDenseSchur(ncv,eps->nconv,T,ncv,U,eps->eigr,eps->eigi);
240: /* 5. Sort diagonal elements in T and accumulate rotations on U */
241: EPSSortDenseSchur(ncv,eps->nconv,T,ncv,U,eps->eigr,eps->eigi,eps->which);
242:
243: /* 6. AV(:,idx) = AV * U(:,idx) */
244: for (i=eps->nconv;i<ncv;i++) {
245: VecSet(eps->work[i],0.0);
246: VecMAXPY(eps->work[i],ncv,U+ncv*i,eps->AV);
247: }
248: for (i=eps->nconv;i<ncv;i++) {
249: VecCopy(eps->work[i],eps->AV[i]);
250: }
251:
252: /* 7. V(:,idx) = V * U(:,idx) */
253: for (i=eps->nconv;i<ncv;i++) {
254: VecSet(eps->work[i],0.0);
255: VecMAXPY(eps->work[i],ncv,U+ncv*i,eps->V);
256: }
257: for (i=eps->nconv;i<ncv;i++) {
258: VecCopy(eps->work[i],eps->V[i]);
259: }
260:
261: /* Compute residuals */
262: for (i=0;i<ncv;i++) { rsdold[i] = rsd[i]; }
264: EPSSchurResidualNorms(eps,eps->V,eps->AV,T,eps->nconv,ncv,ncv,rsd);
266: for (i=0;i<ncv;i++) {
267: eps->errest[i] = rsd[i] / SlepcAbsEigenvalue(eps->eigr[i],eps->eigi[i]);
268: }
269: EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,ncv);
270:
271: /* Convergence check */
272: for (i=0;i<ncv;i++) { itrsdold[i] = itrsd[i]; }
273: for (i=eps->nconv;i<ncv;i++) { itrsd[i] = its; }
274:
275: for (;;) {
276: /* Find group in currently computed eigenvalues */
277: EPSFindGroup(eps->nconv,ncv,eps->eigr,eps->eigi,rsd,grptol,&ngrp,&ctr,&ae,&arsd);
278: if (ngrp!=nogrp) break;
279: if (ngrp==0) break;
280: if (PetscAbsScalar(ae-oae)>ctr*cnvtol*(itrsd[eps->nconv]-itrsdold[eps->nconv])) break;
281: if (arsd>ctr*eps->tol) break;
282: eps->nconv = eps->nconv + ngrp;
283: if (eps->nconv>=ncv) break;
284: }
285:
286: if (eps->nconv>=eps->nev) break;
287:
288: /* Compute nxtsrr (iteration of next projection step) */
289: nxtsrr = PetscMin(eps->max_it,PetscMax((int)floor(stpfac*its), init));
290:
291: if (ngrp!=nogrp || ngrp==0 || arsd>=oarsd) {
292: idsrr = nxtsrr - its;
293: } else {
294: idsrr = (int)floor(alpha+beta*(itrsdold[eps->nconv]-itrsd[eps->nconv])*log(arsd/eps->tol)/log(arsd/oarsd));
295: idsrr = PetscMax(1,idsrr);
296: }
297: nxtsrr = PetscMin(nxtsrr,its+idsrr);
299: /* Compute nxtort (iteration of next orthogonalization step) */
300: PetscMemcpy(U,T,sizeof(PetscScalar)*ncv);
301: EPSHessCond(U,ncv,&tcond);
302: idort = PetscMax(1,(int)floor(orttol/PetscMax(1,log10(tcond))));
303: nxtort = PetscMin(its+idort, nxtsrr);
305: /* V(:,idx) = AV(:,idx) */
306: for (i=eps->nconv;i<ncv;i++) {
307: VecCopy(eps->AV[i],eps->V[i]);
308: }
309: its++;
311: /* Orthogonalization loop */
312: do {
313: while (its<nxtort) {
314:
315: /* AV(:,idx) = OP * V(:,idx) */
316: for (i=eps->nconv;i<ncv;i++) {
317: STApply(eps->OP,eps->V[i],eps->AV[i]);
318: }
319:
320: /* V(:,idx) = AV(:,idx) with normalization */
321: for (i=eps->nconv;i<ncv;i++) {
322: VecCopy(eps->AV[i],eps->V[i]);
323: VecNorm(eps->V[i],NORM_INFINITY,&norm);
324: VecScale(eps->V[i],1/norm);
325: }
326:
327: its++;
328: }
329: /* Orthonormalize vectors */
330: for (i=eps->nconv;i<ncv;i++) {
331: EPSOrthogonalize(eps,i+eps->nds,PETSC_NULL,eps->DSV,eps->V[i],PETSC_NULL,&norm,&breakdown);
332: if (breakdown) {
333: SlepcVecSetRandom(eps->V[i]);
334: EPSOrthogonalize(eps,i+eps->nds,PETSC_NULL,eps->DSV,eps->V[i],PETSC_NULL,&norm,&breakdown);
335: }
336: VecScale(eps->V[i],1/norm);
337: }
338: nxtort = PetscMin(its+idort,nxtsrr);
339: } while (its<nxtsrr);
340: }
342: PetscFree(U);
343: PetscFree(rsd);
344: PetscFree(rsdold);
345: PetscFree(itrsd);
346: PetscFree(itrsdold);
348: if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
349: else eps->reason = EPS_DIVERGED_ITS;
351: return(0);
352: }
357: PetscErrorCode EPSCreate_SUBSPACE(EPS eps)
358: {
360: eps->ops->solve = EPSSolve_SUBSPACE;
361: eps->ops->setup = EPSSetUp_SUBSPACE;
362: eps->ops->destroy = EPSDestroy_Default;
363: eps->ops->backtransform = EPSBackTransform_Default;
364: eps->ops->computevectors = EPSComputeVectors_Schur;
365: return(0);
366: }