Actual source code: rqcg.c

  1: /*

  3:    SLEPc eigensolver: "rqcg"

  5:    Method: Rayleigh Quotient Conjugate Gradient

  7:    Algorithm:

  9:        Conjugate Gradient minimization of the Rayleigh quotient with
 10:        periodic Rayleigh-Ritz acceleration.

 12:    References:

 14:        [1] L. Bergamaschi et al., "Parallel preconditioned conjugate gradient
 15:            optimization of the Rayleigh quotient for the solution of sparse
 16:            eigenproblems", Appl. Math. Comput. 175(2):1694-1715, 2006.

 18:    Last update: Jul 2012

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

 24:    This file is part of SLEPc.

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

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

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

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

 43: PetscErrorCode EPSSolve_RQCG(EPS);

 45: typedef struct {
 46:   PetscInt nrest;
 47:   Vec      *AV,*BV,*P,*G;
 48: } EPS_RQCG;

 52: PetscErrorCode EPSSetUp_RQCG(EPS eps)
 53: {
 55:   PetscBool      precond;
 56:   PetscInt       nmat;
 57:   EPS_RQCG       *ctx = (EPS_RQCG*)eps->data;

 60:   if (!eps->ishermitian) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"RQCG only works for Hermitian problems");
 61:   if (eps->ncv) { /* ncv set */
 62:     if (eps->ncv<eps->nev) SETERRQ(PetscObjectComm((PetscObject)eps),1,"The value of ncv must be at least nev");
 63:   }
 64:   else if (eps->mpd) { /* mpd set */
 65:     eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd);
 66:   }
 67:   else { /* neither set: defaults depend on nev being small or large */
 68:     if (eps->nev<500) eps->ncv = PetscMin(eps->n,PetscMax(2*eps->nev,eps->nev+15));
 69:     else {
 70:       eps->mpd = 500;
 71:       eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd);
 72:     }
 73:   }
 74:   if (!eps->mpd) eps->mpd = eps->ncv;
 75:   if (!eps->max_it) eps->max_it = PetscMax(100,2*eps->n/eps->ncv);
 76:   if (!eps->which) eps->which = EPS_SMALLEST_REAL;
 77:   if (eps->which!=EPS_SMALLEST_REAL) SETERRQ(PetscObjectComm((PetscObject)eps),1,"Wrong value of eps->which");
 78:   if (!eps->extraction) {
 79:     EPSSetExtraction(eps,EPS_RITZ);
 80:   } else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
 81:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");
 82:   /* Set STPrecond as the default ST */
 83:   if (!((PetscObject)eps->st)->type_name) {
 84:     STSetType(eps->st,STPRECOND);
 85:   }
 86:   PetscObjectTypeCompare((PetscObject)eps->st,STPRECOND,&precond);
 87:   if (!precond) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"RQCG only works with precond ST");

 89:   if (!ctx->nrest) ctx->nrest = 20;

 91:   EPSAllocateSolution(eps);
 92:   VecDuplicateVecs(eps->t,eps->mpd,&ctx->AV);
 93:   PetscLogObjectParent(eps,ctx->AV);
 94:   STGetNumMatrices(eps->st,&nmat);
 95:   if (nmat>1) {
 96:     VecDuplicateVecs(eps->t,eps->mpd,&ctx->BV);
 97:     PetscLogObjectParent(eps,ctx->BV);
 98:   }
 99:   VecDuplicateVecs(eps->t,eps->mpd,&ctx->P);
100:   PetscLogObjectParent(eps,ctx->P);
101:   VecDuplicateVecs(eps->t,eps->mpd,&ctx->G);
102:   PetscLogObjectParent(eps,ctx->G);
103:   DSSetType(eps->ds,DSHEP);
104:   DSAllocate(eps->ds,eps->ncv);
105:   EPSSetWorkVecs(eps,1);

107:   /* dispatch solve method */
108:   if (eps->leftvecs) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Left vectors not supported in this solver");
109:   eps->ops->solve = EPSSolve_RQCG;
110:   return(0);
111: }

115: PetscErrorCode EPSSolve_RQCG(EPS eps)
116: {
118:   EPS_RQCG       *ctx = (EPS_RQCG*)eps->data;
119:   PetscInt       i,j,k,ld,off,nv,ncv = eps->ncv,kini,nmat;
120:   PetscScalar    *C,*Y,*gamma,g,pap,pbp,pbx,pax,nu,mu,alpha,beta;
121:   PetscReal      resnorm,norm,a,b,c,disc,t;
122:   PetscBool      reset,breakdown;
123:   Mat            A,B;
124:   Vec            w=eps->work[0];

127:   DSGetLeadingDimension(eps->ds,&ld);
128:   STGetNumMatrices(eps->st,&nmat);
129:   STGetOperators(eps->st,0,&A);
130:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
131:   else B = NULL;
132:   PetscMalloc(eps->mpd*sizeof(PetscScalar),&gamma);

134:   kini = eps->nini;
135:   while (eps->reason == EPS_CONVERGED_ITERATING) {
136:     eps->its++;
137:     nv = PetscMin(eps->nconv+eps->mpd,ncv);
138:     DSSetDimensions(eps->ds,nv,0,eps->nconv,0);
139:     /* Generate more initial vectors if necessary */
140:     while (kini<nv) {
141:       SlepcVecSetRandom(eps->V[kini],eps->rand);
142:       IPOrthogonalize(eps->ip,eps->nds,eps->defl,kini,NULL,eps->V,eps->V[kini],NULL,&norm,&breakdown);
143:       if (norm>0.0 && !breakdown) {
144:         VecScale(eps->V[kini],1.0/norm);
145:         kini++;
146:       }
147:     }
148:     reset = (eps->its>1 && (eps->its-1)%ctx->nrest==0)? PETSC_TRUE: PETSC_FALSE;

150:     if (reset) {
151:       /* Compute Rayleigh quotient */
152:       DSGetArray(eps->ds,DS_MAT_A,&C);
153:       for (i=eps->nconv;i<nv;i++) {
154:         MatMult(A,eps->V[i],ctx->AV[i-eps->nconv]);
155:         VecMDot(ctx->AV[i-eps->nconv],i-eps->nconv+1,eps->V+eps->nconv,C+eps->nconv+i*ld);
156:         for (j=eps->nconv;j<i-1;j++) C[i+j*ld] = C[j+i*ld];
157:       }
158:       DSRestoreArray(eps->ds,DS_MAT_A,&C);
159:       DSSetState(eps->ds,DS_STATE_RAW);

161:       /* Solve projected problem */
162:       DSSolve(eps->ds,eps->eigr,eps->eigi);
163:       DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);

165:       /* Update vectors V(:,idx) = V * Y(:,idx) */
166:       DSGetArray(eps->ds,DS_MAT_Q,&Y);
167:       off = eps->nconv+eps->nconv*ld;
168:       SlepcUpdateVectors(nv-eps->nconv,ctx->AV,0,nv-eps->nconv,Y+off,ld,PETSC_FALSE);
169:       SlepcUpdateVectors(nv-eps->nconv,eps->V+eps->nconv,0,nv-eps->nconv,Y+off,ld,PETSC_FALSE);
170:       DSRestoreArray(eps->ds,DS_MAT_Q,&Y);

172:     } else {
173:       /* No need to do Rayleigh-Ritz, just take diag(V'*A*V) */
174:       for (i=eps->nconv;i<nv;i++) {
175:         MatMult(A,eps->V[i],ctx->AV[i-eps->nconv]);
176:         VecDot(ctx->AV[i-eps->nconv],eps->V[i],eps->eigr+i);
177:       }
178:     }

180:     /* Compute gradient and check convergence */
181:     k = -1;
182:     for (i=eps->nconv;i<nv;i++) {
183:       if (B) {
184:         MatMult(B,eps->V[i],ctx->BV[i-eps->nconv]);
185:         VecWAXPY(ctx->G[i-eps->nconv],-eps->eigr[i],ctx->BV[i-eps->nconv],ctx->AV[i-eps->nconv]);
186:       } else {
187:         VecWAXPY(ctx->G[i-eps->nconv],-eps->eigr[i],eps->V[i],ctx->AV[i-eps->nconv]);
188:       }
189:       VecNorm(ctx->G[i-eps->nconv],NORM_2,&resnorm);
190:       (*eps->converged)(eps,eps->eigr[i],0.0,resnorm,&eps->errest[i],eps->convergedctx);
191:       if (k==-1 && eps->errest[i] >= eps->tol) k = i;
192:     }
193:     if (k==-1) k = nv;
194:     if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
195:     if (k >= eps->nev) eps->reason = EPS_CONVERGED_TOL;

197:     /* The next lines are necessary to avoid DS zeroing eigr */
198:     DSGetArray(eps->ds,DS_MAT_A,&C);
199:     for (i=eps->nconv;i<k;i++) C[i+i*ld] = eps->eigr[i];
200:     DSRestoreArray(eps->ds,DS_MAT_A,&C);

202:     if (eps->reason == EPS_CONVERGED_ITERATING) {

204:       /* Search direction */
205:       for (i=0;i<nv-eps->nconv;i++) {
206:         STMatSolve(eps->st,0,ctx->G[i],w);
207:         VecDot(ctx->G[i],w,&g);
208:         beta = (!reset && eps->its>1)? g/gamma[i]: 0.0;
209:         gamma[i] = g;
210:         VecAXPBY(ctx->P[i],1.0,beta,w);
211:         IPOrthogonalize(eps->ip,eps->nds,eps->defl,i+eps->nconv,NULL,eps->V,ctx->P[i],NULL,&resnorm,&breakdown);
212:       }

214:       /* Minimization problem */
215:       for (i=eps->nconv;i<nv;i++) {
216:         VecDot(eps->V[i],ctx->AV[i-eps->nconv],&nu);
217:         VecDot(ctx->P[i-eps->nconv],ctx->AV[i-eps->nconv],&pax);
218:         MatMult(A,ctx->P[i-eps->nconv],w);
219:         VecDot(ctx->P[i-eps->nconv],w,&pap);
220:         if (B) {
221:           VecDot(eps->V[i],ctx->BV[i-eps->nconv],&mu);
222:           VecDot(ctx->P[i-eps->nconv],ctx->BV[i-eps->nconv],&pbx);
223:           MatMult(B,ctx->P[i-eps->nconv],w);
224:           VecDot(ctx->P[i-eps->nconv],w,&pbp);
225:         } else {
226:           VecDot(eps->V[i],eps->V[i],&mu);
227:           VecDot(ctx->P[i-eps->nconv],eps->V[i],&pbx);
228:           VecDot(ctx->P[i-eps->nconv],ctx->P[i-eps->nconv],&pbp);
229:         }
230:         a = PetscRealPart(pap*pbx-pax*pbp);
231:         b = PetscRealPart(nu*pbp-mu*pap);
232:         c = PetscRealPart(mu*pax-nu*pbx);
233:         t = PetscMax(PetscMax(PetscAbsReal(a),PetscAbsReal(b)),PetscAbsReal(c));
234:         if (t!=0.0) { a /= t; b /= t; c /= t; }
235:         disc = PetscSqrtReal(PetscAbsReal(b*b-4.0*a*c));
236:         if (b>=0.0 && a!=0.0) alpha = (b+disc)/(2.0*a);
237:         else if (b!=disc) alpha = 2.0*c/(b-disc);
238:         else alpha = 0;
239:         /* Next iterate */
240:         if (alpha!=0.0) {
241:           VecAXPY(eps->V[i],alpha,ctx->P[i-eps->nconv]);
242:         }
243:         IPOrthogonalize(eps->ip,eps->nds,eps->defl,i,NULL,eps->V,eps->V[i],NULL,&norm,&breakdown);
244:         if (!breakdown && norm!=0.0) {
245:           VecScale(eps->V[i],1.0/norm);
246:         }
247:       }
248:     }

250:     EPSMonitor(eps,eps->its,k,eps->eigr,eps->eigi,eps->errest,nv);
251:     eps->nconv = k;
252:   }

254:   PetscFree(gamma);
255:   /* truncate Schur decomposition and change the state to raw so that
256:      PSVectors() computes eigenvectors from scratch */
257:   DSSetDimensions(eps->ds,eps->nconv,0,0,0);
258:   DSSetState(eps->ds,DS_STATE_RAW);
259:   return(0);
260: }

264: static PetscErrorCode EPSRQCGSetReset_RQCG(EPS eps,PetscInt nrest)
265: {
266:   EPS_RQCG *ctx = (EPS_RQCG*)eps->data;

269:   ctx->nrest = nrest;
270:   return(0);
271: }

275: /*@
276:    EPSRQCGSetReset - Sets the reset parameter of the RQCG iteration. Every
277:    nrest iterations, the solver performs a Rayleigh-Ritz projection step.

279:    Logically Collective on EPS

281:    Input Parameters:
282: +  eps - the eigenproblem solver context
283: -  nrest - the number of iterations between resets

285:    Options Database Key:
286: .  -eps_rqcg_reset - Sets the reset parameter

288:    Level: advanced

290: .seealso: EPSRQCGGetReset()
291: @*/
292: PetscErrorCode EPSRQCGSetReset(EPS eps,PetscInt nrest)
293: {

299:   PetscTryMethod(eps,"EPSRQCGSetReset_C",(EPS,PetscInt),(eps,nrest));
300:   return(0);
301: }

305: static PetscErrorCode EPSRQCGGetReset_RQCG(EPS eps,PetscInt *nrest)
306: {
307:   EPS_RQCG *ctx = (EPS_RQCG*)eps->data;

310:   *nrest = ctx->nrest;
311:   return(0);
312: }

316: /*@
317:    EPSRQCGGetReset - Gets the reset parameter used in the RQCG method.

319:    Not Collective

321:    Input Parameter:
322: .  eps - the eigenproblem solver context

324:    Output Parameter:
325: .  nrest - the reset parameter

327:    Level: advanced

329: .seealso: EPSRQCGSetReset()
330: @*/
331: PetscErrorCode EPSRQCGGetReset(EPS eps,PetscInt *nrest)
332: {

338:   PetscTryMethod(eps,"EPSRQCGGetReset_C",(EPS,PetscInt*),(eps,nrest));
339:   return(0);
340: }

344: PetscErrorCode EPSReset_RQCG(EPS eps)
345: {
347:   EPS_RQCG       *ctx = (EPS_RQCG*)eps->data;

350:   VecDestroyVecs(eps->mpd,&ctx->AV);
351:   VecDestroyVecs(eps->mpd,&ctx->BV);
352:   VecDestroyVecs(eps->mpd,&ctx->P);
353:   VecDestroyVecs(eps->mpd,&ctx->G);
354:   ctx->nrest = 0;
355:   EPSReset_Default(eps);
356:   return(0);
357: }

361: PetscErrorCode EPSSetFromOptions_RQCG(EPS eps)
362: {
364:   PetscBool      flg;
365:   PetscInt       nrest;

368:   PetscOptionsHead("EPS RQCG Options");
369:   PetscOptionsInt("-eps_rqcg_reset","RQCG reset parameter","EPSRQCGSetReset",20,&nrest,&flg);
370:   if (flg) {
371:     EPSRQCGSetReset(eps,nrest);
372:   }
373:   PetscOptionsTail();
374:   return(0);
375: }

379: PetscErrorCode EPSDestroy_RQCG(EPS eps)
380: {

384:   PetscFree(eps->data);
385:   PetscObjectComposeFunction((PetscObject)eps,"EPSRQCGSetReset_C",NULL);
386:   PetscObjectComposeFunction((PetscObject)eps,"EPSRQCGGetReset_C",NULL);
387:   return(0);
388: }

392: PetscErrorCode EPSView_RQCG(EPS eps,PetscViewer viewer)
393: {
395:   EPS_RQCG       *ctx = (EPS_RQCG*)eps->data;
396:   PetscBool      isascii;

399:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
400:   if (isascii) {
401:     PetscViewerASCIIPrintf(viewer,"  RQCG: reset every %D iterations\n",ctx->nrest);
402:   }
403:   return(0);
404: }

408: PETSC_EXTERN PetscErrorCode EPSCreate_RQCG(EPS eps)
409: {

413:   PetscNewLog(eps,EPS_RQCG,&eps->data);
414:   eps->ops->setup          = EPSSetUp_RQCG;
415:   eps->ops->setfromoptions = EPSSetFromOptions_RQCG;
416:   eps->ops->destroy        = EPSDestroy_RQCG;
417:   eps->ops->reset          = EPSReset_RQCG;
418:   eps->ops->view           = EPSView_RQCG;
419:   eps->ops->backtransform  = EPSBackTransform_Default;
420:   eps->ops->computevectors = EPSComputeVectors_Default;
421:   STSetType(eps->st,STPRECOND);
422:   STPrecondSetKSPHasMat(eps->st,PETSC_TRUE);
423:   PetscObjectComposeFunction((PetscObject)eps,"EPSRQCGSetReset_C",EPSRQCGSetReset_RQCG);
424:   PetscObjectComposeFunction((PetscObject)eps,"EPSRQCGGetReset_C",EPSRQCGGetReset_RQCG);
425:   return(0);
426: }