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: }