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: Feb 2009

 19:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 20:    SLEPc - Scalable Library for Eigenvalue Problem Computations
 21:    Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain

 23:    This file is part of SLEPc.

 25:    SLEPc is free software: you can redistribute it and/or modify it under  the
 26:    terms of version 3 of the GNU Lesser General Public License as published by
 27:    the Free Software Foundation.

 29:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
 30:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
 31:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
 32:    more details.

 34:    You  should have received a copy of the GNU Lesser General  Public  License
 35:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
 36:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 37: */

 39: #include <slepc-private/epsimpl.h>                /*I "slepceps.h" I*/
 40: #include <slepcblaslapack.h>

 42: PetscErrorCode EPSSolve_Subspace(EPS);

 44: typedef struct {
 45:   Vec *AV;
 46: } EPS_SUBSPACE;

 50: PetscErrorCode EPSSetUp_Subspace(EPS eps)
 51: {
 53:   EPS_SUBSPACE   *ctx = (EPS_SUBSPACE*)eps->data;

 56:   if (eps->ncv) { /* ncv set */
 57:     if (eps->ncv<eps->nev) SETERRQ(PetscObjectComm((PetscObject)eps),1,"The value of ncv must be at least nev");
 58:   } else if (eps->mpd) { /* mpd set */
 59:     eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd);
 60:   } else { /* neither set: defaults depend on nev being small or large */
 61:     if (eps->nev<500) eps->ncv = PetscMin(eps->n,PetscMax(2*eps->nev,eps->nev+15));
 62:     else {
 63:       eps->mpd = 500;
 64:       eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd);
 65:     }
 66:   }
 67:   if (!eps->mpd) eps->mpd = eps->ncv;
 68:   if (!eps->max_it) eps->max_it = PetscMax(100,2*eps->n/eps->ncv);
 69:   if (!eps->which) { EPSSetWhichEigenpairs_Default(eps); }
 70:   if (eps->which!=EPS_LARGEST_MAGNITUDE && eps->which!=EPS_TARGET_MAGNITUDE) SETERRQ(PetscObjectComm((PetscObject)eps),1,"Wrong value of eps->which");
 71:   if (!eps->extraction) {
 72:     EPSSetExtraction(eps,EPS_RITZ);
 73:   } else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
 74:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");

 76:   EPSAllocateSolution(eps);
 77:   VecDuplicateVecs(eps->t,eps->ncv,&ctx->AV);
 78:   PetscLogObjectParents(eps,eps->ncv,ctx->AV);
 79:   if (eps->ishermitian) {
 80:     DSSetType(eps->ds,DSHEP);
 81:   } else {
 82:     DSSetType(eps->ds,DSNHEP);
 83:   }
 84:   DSAllocate(eps->ds,eps->ncv);
 85:   EPSSetWorkVecs(eps,1);

 87:   /* dispatch solve method */
 88:   if (eps->leftvecs) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Left vectors not supported in this solver");
 89:   if (eps->isgeneralized && eps->ishermitian && !eps->ispositive) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Requested method does not work for indefinite problems");
 90:   eps->ops->solve = EPSSolve_Subspace;
 91:   return(0);
 92: }

 96: /*
 97:    EPSSubspaceFindGroup - Find a group of nearly equimodular eigenvalues, provided
 98:    in arrays wr and wi, according to the tolerance grptol. Also the 2-norms
 99:    of the residuals must be passed in (rsd). Arrays are processed from index
100:    l to index m only. The output information is:

102:    ngrp - number of entries of the group
103:    ctr  - (w(l)+w(l+ngrp-1))/2
104:    ae   - average of wr(l),...,wr(l+ngrp-1)
105:    arsd - average of rsd(l),...,rsd(l+ngrp-1)
106: */
107: static PetscErrorCode EPSSubspaceFindGroup(PetscInt l,PetscInt m,PetscScalar *wr,PetscScalar *wi,PetscReal *rsd,PetscReal grptol,PetscInt *ngrp,PetscReal *ctr,PetscReal *ae,PetscReal *arsd)
108: {
109:   PetscInt  i;
110:   PetscReal rmod,rmod1;

113:   *ngrp = 0;
114:   *ctr = 0;
115:   rmod = SlepcAbsEigenvalue(wr[l],wi[l]);

117:   for (i=l;i<m;) {
118:     rmod1 = SlepcAbsEigenvalue(wr[i],wi[i]);
119:     if (PetscAbsReal(rmod-rmod1) > grptol*(rmod+rmod1)) break;
120:     *ctr = (rmod+rmod1)/2.0;
121:     if (wi[i] != 0.0) {
122:       (*ngrp)+=2;
123:       i+=2;
124:     } else {
125:       (*ngrp)++;
126:       i++;
127:     }
128:   }

130:   *ae = 0;
131:   *arsd = 0;
132:   if (*ngrp) {
133:     for (i=l;i<l+*ngrp;i++) {
134:       (*ae) += PetscRealPart(wr[i]);
135:       (*arsd) += rsd[i]*rsd[i];
136:     }
137:     *ae = *ae / *ngrp;
138:     *arsd = PetscSqrtScalar(*arsd / *ngrp);
139:   }
140:   return(0);
141: }

145: /*
146:    EPSSubspaceResidualNorms - Computes the column norms of residual vectors
147:    OP*V(1:n,l:m) - V*T(1:m,l:m), where, on entry, OP*V has been computed and
148:    stored in AV. ldt is the leading dimension of T. On exit, rsd(l) to
149:    rsd(m) contain the computed norms.
150: */
151: static PetscErrorCode EPSSubspaceResidualNorms(Vec *V,Vec *AV,PetscScalar *T,PetscInt l,PetscInt m,PetscInt ldt,Vec w,PetscReal *rsd)
152: {
154:   PetscInt       i,k;
155:   PetscScalar    t;

158:   for (i=l;i<m;i++) {
159:     if (i==m-1 || T[i+1+ldt*i]==0.0) k=i+1;
160:     else k=i+2;
161:     VecCopy(AV[i],w);
162:     SlepcVecMAXPBY(w,1.0,-1.0,k,T+ldt*i,V);
163:     VecDot(w,w,&t);
164:     rsd[i] = PetscRealPart(t);
165:   }
166:   for (i=l;i<m;i++) {
167:     if (i == m-1) {
168:       rsd[i] = PetscSqrtReal(rsd[i]);
169:     } else if (T[i+1+(ldt*i)]==0.0) {
170:       rsd[i] = PetscSqrtReal(rsd[i]);
171:     } else {
172:       rsd[i] = PetscSqrtReal((rsd[i]+rsd[i+1])/2.0);
173:       rsd[i+1] = rsd[i];
174:       i++;
175:     }
176:   }
177:   return(0);
178: }

182: PetscErrorCode EPSSolve_Subspace(EPS eps)
183: {
185:   EPS_SUBSPACE   *ctx = (EPS_SUBSPACE*)eps->data;
186:   PetscInt       i,k,ld,ngrp,nogrp,*itrsd,*itrsdold;
187:   PetscInt       nxtsrr,idsrr,idort,nxtort,nv,ncv = eps->ncv,its;
188:   PetscScalar    *T,*U;
189:   PetscReal      arsd,oarsd,ctr,octr,ae,oae,*rsd,norm,tcond=1.0;
190:   PetscBool      breakdown;
191:   /* Parameters */
192:   PetscInt       init = 5;        /* Number of initial iterations */
193:   PetscReal      stpfac = 1.5;    /* Max num of iter before next SRR step */
194:   PetscReal      alpha = 1.0;     /* Used to predict convergence of next residual */
195:   PetscReal      beta = 1.1;      /* Used to predict convergence of next residual */
196:   PetscReal      grptol = 1e-8;   /* Tolerance for EPSSubspaceFindGroup */
197:   PetscReal      cnvtol = 1e-6;   /* Convergence criterion for cnv */
198:   PetscInt       orttol = 2;      /* Number of decimal digits whose loss
199:                                      can be tolerated in orthogonalization */

202:   its = 0;
203:   PetscMalloc(sizeof(PetscReal)*ncv,&rsd);
204:   PetscMalloc(sizeof(PetscInt)*ncv,&itrsd);
205:   PetscMalloc(sizeof(PetscInt)*ncv,&itrsdold);
206:   DSGetLeadingDimension(eps->ds,&ld);

208:   for (i=0;i<ncv;i++) {
209:     rsd[i] = 0.0;
210:     itrsd[i] = -1;
211:   }

213:   /* Complete the initial basis with random vectors and orthonormalize them */
214:   k = eps->nini;
215:   while (k<ncv) {
216:     SlepcVecSetRandom(eps->V[k],eps->rand);
217:     IPOrthogonalize(eps->ip,eps->nds,eps->defl,k,NULL,eps->V,eps->V[k],NULL,&norm,&breakdown);
218:     if (norm>0.0 && !breakdown) {
219:       VecScale(eps->V[k],1.0/norm);
220:       k++;
221:     }
222:   }

224:   while (eps->its<eps->max_it) {
225:     eps->its++;
226:     nv = PetscMin(eps->nconv+eps->mpd,ncv);
227:     DSSetDimensions(eps->ds,nv,0,eps->nconv,0);

229:     /* Find group in previously computed eigenvalues */
230:     EPSSubspaceFindGroup(eps->nconv,nv,eps->eigr,eps->eigi,rsd,grptol,&nogrp,&octr,&oae,&oarsd);

232:     /* AV(:,idx) = OP * V(:,idx) */
233:     for (i=eps->nconv;i<nv;i++) {
234:       STApply(eps->st,eps->V[i],ctx->AV[i]);
235:     }

237:     /* T(:,idx) = V' * AV(:,idx) */
238:     DSGetArray(eps->ds,DS_MAT_A,&T);
239:     for (i=eps->nconv;i<nv;i++) {
240:       VecMDot(ctx->AV[i],nv,eps->V,T+i*ld);
241:     }
242:     DSRestoreArray(eps->ds,DS_MAT_A,&T);
243:     DSSetState(eps->ds,DS_STATE_RAW);

245:     /* Solve projected problem */
246:     DSSolve(eps->ds,eps->eigr,eps->eigi);
247:     DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);

249:     /* Update vectors V(:,idx) = V * U(:,idx) */
250:     DSGetArray(eps->ds,DS_MAT_Q,&U);
251:     SlepcUpdateVectors(nv,ctx->AV,eps->nconv,nv,U,ld,PETSC_FALSE);
252:     SlepcUpdateVectors(nv,eps->V,eps->nconv,nv,U,ld,PETSC_FALSE);
253:     DSRestoreArray(eps->ds,DS_MAT_Q,&U);

255:     /* Convergence check */
256:     DSGetArray(eps->ds,DS_MAT_A,&T);
257:     EPSSubspaceResidualNorms(eps->V,ctx->AV,T,eps->nconv,nv,ld,eps->work[0],rsd);
258:     DSRestoreArray(eps->ds,DS_MAT_A,&T);

260:     for (i=eps->nconv;i<nv;i++) {
261:       itrsdold[i] = itrsd[i];
262:       itrsd[i] = its;
263:       eps->errest[i] = rsd[i];
264:     }

266:     for (;;) {
267:       /* Find group in currently computed eigenvalues */
268:       EPSSubspaceFindGroup(eps->nconv,nv,eps->eigr,eps->eigi,eps->errest,grptol,&ngrp,&ctr,&ae,&arsd);
269:       if (ngrp!=nogrp) break;
270:       if (ngrp==0) break;
271:       if (PetscAbsScalar(ae-oae)>ctr*cnvtol*(itrsd[eps->nconv]-itrsdold[eps->nconv])) break;
272:       if (arsd>ctr*eps->tol) break;
273:       eps->nconv = eps->nconv + ngrp;
274:       if (eps->nconv>=nv) break;
275:     }

277:     EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,nv);
278:     if (eps->nconv>=eps->nev) break;

280:     /* Compute nxtsrr (iteration of next projection step) */
281:     nxtsrr = PetscMin(eps->max_it,PetscMax((PetscInt)floor(stpfac*its),init));

283:     if (ngrp!=nogrp || ngrp==0 || arsd>=oarsd) {
284:       idsrr = nxtsrr - its;
285:     } else {
286:       idsrr = (PetscInt)floor(alpha+beta*(itrsdold[eps->nconv]-itrsd[eps->nconv])*log(arsd/eps->tol)/log(arsd/oarsd));
287:       idsrr = PetscMax(1,idsrr);
288:     }
289:     nxtsrr = PetscMin(nxtsrr,its+idsrr);

291:     /* Compute nxtort (iteration of next orthogonalization step) */
292:     DSCond(eps->ds,&tcond);
293:     idort = PetscMax(1,(PetscInt)floor(orttol/PetscMax(1,log10(tcond))));
294:     nxtort = PetscMin(its+idort,nxtsrr);

296:     /* V(:,idx) = AV(:,idx) */
297:     for (i=eps->nconv;i<nv;i++) {
298:       VecCopy(ctx->AV[i],eps->V[i]);
299:     }
300:     its++;

302:     /* Orthogonalization loop */
303:     do {
304:       while (its<nxtort) {

306:         /* AV(:,idx) = OP * V(:,idx) */
307:         for (i=eps->nconv;i<nv;i++) {
308:           STApply(eps->st,eps->V[i],ctx->AV[i]);
309:         }

311:         /* V(:,idx) = AV(:,idx) with normalization */
312:         for (i=eps->nconv;i<nv;i++) {
313:           VecCopy(ctx->AV[i],eps->V[i]);
314:           VecNorm(eps->V[i],NORM_INFINITY,&norm);
315:           VecScale(eps->V[i],1/norm);
316:         }
317:         its++;
318:       }
319:       /* Orthonormalize vectors */
320:       for (i=eps->nconv;i<nv;i++) {
321:         IPOrthogonalize(eps->ip,eps->nds,eps->defl,i,NULL,eps->V,eps->V[i],NULL,&norm,&breakdown);
322:         if (breakdown) {
323:           SlepcVecSetRandom(eps->V[i],eps->rand);
324:           IPOrthogonalize(eps->ip,eps->nds,eps->defl,i,NULL,eps->V,eps->V[i],NULL,&norm,&breakdown);
325:         }
326:         VecScale(eps->V[i],1/norm);
327:       }
328:       nxtort = PetscMin(its+idort,nxtsrr);
329:     } while (its<nxtsrr);
330:   }

332:   PetscFree(rsd);
333:   PetscFree(itrsd);
334:   PetscFree(itrsdold);

336:   if (eps->nconv == eps->nev) eps->reason = EPS_CONVERGED_TOL;
337:   else eps->reason = EPS_DIVERGED_ITS;
338:   /* truncate Schur decomposition and change the state to raw so that
339:      PSVectors() computes eigenvectors from scratch */
340:   DSSetDimensions(eps->ds,eps->nconv,0,0,0);
341:   DSSetState(eps->ds,DS_STATE_RAW);
342:   return(0);
343: }

347: PetscErrorCode EPSReset_Subspace(EPS eps)
348: {
350:   EPS_SUBSPACE   *ctx = (EPS_SUBSPACE*)eps->data;

353:   VecDestroyVecs(eps->ncv,&ctx->AV);
354:   EPSReset_Default(eps);
355:   return(0);
356: }

360: PetscErrorCode EPSDestroy_Subspace(EPS eps)
361: {

365:   PetscFree(eps->data);
366:   return(0);
367: }

371: PETSC_EXTERN PetscErrorCode EPSCreate_Subspace(EPS eps)
372: {

376:   PetscNewLog(eps,EPS_SUBSPACE,&eps->data);
377:   eps->ops->setup                = EPSSetUp_Subspace;
378:   eps->ops->destroy              = EPSDestroy_Subspace;
379:   eps->ops->reset                = EPSReset_Subspace;
380:   eps->ops->backtransform        = EPSBackTransform_Default;
381:   eps->ops->computevectors       = EPSComputeVectors_Schur;
382:   return(0);
383: }