Actual source code: lanczos.c

  1: /*                       

  3:    SLEPc eigensolver: "lanczos"

  5:    Method: Explicitly Restarted Symmetric/Hermitian Lanczos

  7:    Algorithm:

  9:        Lanczos method for symmetric (Hermitian) problems, with explicit 
 10:        restart and deflation. Several reorthogonalization strategies can
 11:        be selected.

 13:    References:

 15:        [1] "Lanczos Methods in SLEPc", SLEPc Technical Report STR-5, 
 16:            available at http://www.grycap.upv.es/slepc.

 18:    Last update: Feb 2009

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

 24:    This file is part of SLEPc.
 25:       
 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 <private/epsimpl.h>                /*I "slepceps.h" I*/

 42: PetscErrorCode EPSSolve_Lanczos(EPS);

 44: typedef struct {
 45:   EPSLanczosReorthogType reorthog;
 46:   Vec *AV;
 47: } EPS_LANCZOS;

 51: PetscErrorCode EPSSetUp_Lanczos(EPS eps)
 52: {
 53:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;

 57:   if (eps->ncv) { /* ncv set */
 58:     if (eps->ncv<eps->nev) SETERRQ(((PetscObject)eps)->comm,1,"The value of ncv must be at least nev");
 59:   }
 60:   else if (eps->mpd) { /* mpd set */
 61:     eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd);
 62:   }
 63:   else { /* neither set: defaults depend on nev being small or large */
 64:     if (eps->nev<500) eps->ncv = PetscMin(eps->n,PetscMax(2*eps->nev,eps->nev+15));
 65:     else { eps->mpd = 500; eps->ncv = PetscMin(eps->n,eps->nev+eps->mpd); }
 66:   }
 67:   if (!eps->mpd) eps->mpd = eps->ncv;
 68:   if (eps->ncv>eps->nev+eps->mpd) SETERRQ(((PetscObject)eps)->comm,1,"The value of ncv must not be larger than nev+mpd");
 69:   if (!eps->max_it) eps->max_it = PetscMax(100,2*eps->n/eps->ncv);

 71:   if (!eps->which) { EPSDefaultSetWhich(eps); }
 72:   switch (eps->which) {
 73:     case EPS_LARGEST_IMAGINARY:
 74:     case EPS_SMALLEST_IMAGINARY:
 75:     case EPS_TARGET_IMAGINARY:
 76:       SETERRQ(((PetscObject)eps)->comm,1,"Wrong value of eps->which");
 77:     default: ; /* default case to remove warning */
 78:   }
 79:   if (!eps->ishermitian)
 80:     SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
 81:   if (!eps->extraction) {
 82:     EPSSetExtraction(eps,EPS_RITZ);
 83:   } else if (eps->extraction!=EPS_RITZ) {
 84:     SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Unsupported extraction type\n");
 85:   }

 87:   EPSAllocateSolution(eps);
 88:   if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_SELECTIVE) {
 89:     VecDuplicateVecs(eps->t,eps->ncv,&lanczos->AV);
 90:   }
 91:   if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
 92:     EPSDefaultGetWork(eps,2);
 93:   } else {
 94:     EPSDefaultGetWork(eps,1);
 95:   }

 97:   /* dispatch solve method */
 98:   if (eps->leftvecs) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Left vectors not supported in this solver");
 99:   eps->ops->solve = EPSSolve_Lanczos;
100:   return(0);
101: }

105: /*
106:    EPSLocalLanczos - Local reorthogonalization.

108:    This is the simplest variant. At each Lanczos step, the corresponding Lanczos vector 
109:    is orthogonalized with respect to the two previous Lanczos vectors, according to
110:    the three term Lanczos recurrence. WARNING: This variant does not track the loss of 
111:    orthogonality that occurs in finite-precision arithmetic and, therefore, the 
112:    generated vectors are not guaranteed to be (semi-)orthogonal.
113: */
114: static PetscErrorCode EPSLocalLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscBool *breakdown)
115: {
117:   PetscInt       i,j,m = *M;
118:   PetscReal      norm;
119:   PetscBool      *which,lwhich[100];
120:   PetscScalar    *hwork,lhwork[100];
121: 
123:   if (m > 100) {
124:     PetscMalloc(sizeof(PetscBool)*m,&which);
125:     PetscMalloc(m*sizeof(PetscScalar),&hwork);
126:   } else {
127:     which = lwhich;
128:     hwork = lhwork;
129:   }
130:   for (i=0;i<k;i++)
131:     which[i] = PETSC_TRUE;

133:   for (j=k;j<m-1;j++) {
134:     STApply(eps->OP,V[j],V[j+1]);
135:     which[j] = PETSC_TRUE;
136:     if (j-2>=k) which[j-2] = PETSC_FALSE;
137:     IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,which,V,V[j+1],hwork,&norm,breakdown);
138:     alpha[j-k] = PetscRealPart(hwork[j]);
139:     beta[j-k] = norm;
140:     if (*breakdown) {
141:       *M = j+1;
142:       if (m > 100) {
143:         PetscFree(which);
144:         PetscFree(hwork);
145:       }
146:       return(0);
147:     } else {
148:       VecScale(V[j+1],1.0/norm);
149:     }
150:   }
151:   STApply(eps->OP,V[m-1],f);
152:   IPOrthogonalize(eps->ip,eps->nds,eps->DS,m,PETSC_NULL,V,f,hwork,&norm,PETSC_NULL);
153:   alpha[m-1-k] = PetscRealPart(hwork[m-1]);
154:   beta[m-1-k] = norm;

156:   if (m > 100) {
157:     PetscFree(which);
158:     PetscFree(hwork);
159:   }
160:   return(0);
161: }

165: /*
166:    EPSSelectiveLanczos - Selective reorthogonalization.
167: */
168: static PetscErrorCode EPSSelectiveLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscBool *breakdown,PetscReal anorm)
169: {
171:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;
172:   PetscInt       i,j,m = *M,n,nritz=0,nritzo;
173:   PetscReal      *d,*e,*ritz,norm;
174:   PetscScalar    *Y,*hwork,lhwork[100];
175:   PetscBool      *which,lwhich[100];

178:   PetscMalloc(m*sizeof(PetscReal),&d);
179:   PetscMalloc(m*sizeof(PetscReal),&e);
180:   PetscMalloc(m*sizeof(PetscReal),&ritz);
181:   PetscMalloc(m*m*sizeof(PetscScalar),&Y);
182:   if (m > 100) {
183:     PetscMalloc(sizeof(PetscBool)*m,&which);
184:     PetscMalloc(m*sizeof(PetscScalar),&hwork);
185:   } else {
186:     which = lwhich;
187:     hwork = lhwork;
188:   }
189:   for (i=0;i<k;i++)
190:     which[i] = PETSC_TRUE;

192:   for (j=k;j<m;j++) {
193:     /* Lanczos step */
194:     STApply(eps->OP,V[j],f);
195:     which[j] = PETSC_TRUE;
196:     if (j-2>=k) which[j-2] = PETSC_FALSE;
197:     IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,which,V,f,hwork,&norm,breakdown);
198:     alpha[j-k] = PetscRealPart(hwork[j]);
199:     beta[j-k] = norm;
200:     if (*breakdown) {
201:       *M = j+1;
202:       break;
203:     }

205:     /* Compute eigenvalues and eigenvectors Y of the tridiagonal block */
206:     n = j-k+1;
207:     for (i=0;i<n;i++) { d[i] = alpha[i]; e[i] = beta[i]; }
208:     EPSDenseTridiagonal(n,d,e,ritz,Y);
209: 
210:     /* Estimate ||A|| */
211:     for (i=0;i<n;i++)
212:       if (PetscAbsReal(ritz[i]) > anorm) anorm = PetscAbsReal(ritz[i]);

214:     /* Compute nearly converged Ritz vectors */
215:     nritzo = 0;
216:     for (i=0;i<n;i++)
217:       if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm)
218:         nritzo++;

220:     if (nritzo>nritz) {
221:       nritz = 0;
222:       for (i=0;i<n;i++) {
223:         if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm) {
224:           SlepcVecMAXPBY(lanczos->AV[nritz],0.0,1.0,n,Y+i*n,V+k);
225:           nritz++;
226:         }
227:       }
228:     }

230:     if (nritz > 0) {
231:       IPOrthogonalize(eps->ip,0,PETSC_NULL,nritz,PETSC_NULL,lanczos->AV,f,hwork,&norm,breakdown);
232:       if (*breakdown) {
233:         *M = j+1;
234:         break;
235:       }
236:     }
237: 
238:     if (j<m-1) {
239:       VecScale(f,1.0 / norm);
240:       VecCopy(f,V[j+1]);
241:     }
242:   }
243: 
244:   PetscFree(d);
245:   PetscFree(e);
246:   PetscFree(ritz);
247:   PetscFree(Y);
248:   if (m > 100) {
249:     PetscFree(which);
250:     PetscFree(hwork);
251:   }
252:   return(0);
253: }

257: static void update_omega(PetscReal *omega,PetscReal *omega_old,PetscInt j,PetscReal *alpha,PetscReal *beta,PetscReal eps1,PetscReal anorm)
258: {
259:   PetscInt       k;
260:   PetscReal      T,binv;

263:   /* Estimate of contribution to roundoff errors from A*v 
264:        fl(A*v) = A*v + f, 
265:      where ||f|| \approx eps1*||A||.
266:      For a full matrix A, a rule-of-thumb estimate is eps1 = sqrt(n)*eps. */
267:   T = eps1*anorm;
268:   binv = 1.0/beta[j+1];

270:   /* Update omega(1) using omega(0)==0. */
271:   omega_old[0]= beta[1]*omega[1] + (alpha[0]-alpha[j])*omega[0] -
272:                 beta[j]*omega_old[0];
273:   if (omega_old[0] > 0)
274:     omega_old[0] = binv*(omega_old[0] + T);
275:   else
276:     omega_old[0] = binv*(omega_old[0] - T);
277: 
278:   /* Update remaining components. */
279:   for (k=1;k<j-1;k++) {
280:     omega_old[k] = beta[k+1]*omega[k+1] + (alpha[k]-alpha[j])*omega[k] +
281:                    beta[k]*omega[k-1] - beta[j]*omega_old[k];
282:     if (omega_old[k] > 0)
283:       omega_old[k] = binv*(omega_old[k] + T);
284:     else
285:       omega_old[k] = binv*(omega_old[k] - T);
286:   }
287:   omega_old[j-1] = binv*T;
288: 
289:   /* Swap omega and omega_old. */
290:   for (k=0;k<j;k++) {
291:     omega[k] = omega_old[k];
292:     omega_old[k] = omega[k];
293:   }
294:   omega[j] = eps1;
295:   PetscFunctionReturnVoid();
296: }

300: static void compute_int(PetscBool *which,PetscReal *mu,PetscInt j,PetscReal delta,PetscReal eta)
301: {
302:   PetscInt  i,k,maxpos;
303:   PetscReal max;
304:   PetscBool found;
305: 
307:   /* initialize which */
308:   found = PETSC_FALSE;
309:   maxpos = 0;
310:   max = 0.0;
311:   for (i=0;i<j;i++) {
312:     if (PetscAbsReal(mu[i]) >= delta) {
313:       which[i] = PETSC_TRUE;
314:       found = PETSC_TRUE;
315:     } else which[i] = PETSC_FALSE;
316:     if (PetscAbsReal(mu[i]) > max) {
317:       maxpos = i;
318:       max = PetscAbsReal(mu[i]);
319:     }
320:   }
321:   if (!found) which[maxpos] = PETSC_TRUE;
322: 
323:   for (i=0;i<j;i++)
324:     if (which[i]) {
325:       /* find left interval */
326:       for (k=i;k>=0;k--) {
327:         if (PetscAbsReal(mu[k])<eta || which[k]) break;
328:         else which[k] = PETSC_TRUE;
329:       }
330:       /* find right interval */
331:       for (k=i+1;k<j;k++) {
332:         if (PetscAbsReal(mu[k])<eta || which[k]) break;
333:         else which[k] = PETSC_TRUE;
334:       }
335:     }
336:   PetscFunctionReturnVoid();
337: }

341: /*
342:    EPSPartialLanczos - Partial reorthogonalization.
343: */
344: static PetscErrorCode EPSPartialLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscBool *breakdown,PetscReal anorm)
345: {
346:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;
348:   PetscInt       i,j,m = *M;
349:   PetscReal      norm,*omega,lomega[100],*omega_old,lomega_old[100],eps1,delta,eta;
350:   PetscBool      *which,lwhich[100],*which2,lwhich2[100],
351:                  reorth = PETSC_FALSE,force_reorth = PETSC_FALSE,
352:                  fro = PETSC_FALSE,estimate_anorm = PETSC_FALSE;
353:   PetscScalar    *hwork,lhwork[100];

356:   if (m>100) {
357:     PetscMalloc(m*sizeof(PetscReal),&omega);
358:     PetscMalloc(m*sizeof(PetscReal),&omega_old);
359:   } else {
360:     omega = lomega;
361:     omega_old = lomega_old;
362:   }
363:   if (m > 100) {
364:     PetscMalloc(sizeof(PetscBool)*m,&which);
365:     PetscMalloc(sizeof(PetscBool)*m,&which2);
366:     PetscMalloc(m*sizeof(PetscScalar),&hwork);
367:   } else {
368:     which = lwhich;
369:     which2 = lwhich2;
370:     hwork = lhwork;
371:   }

373:   eps1 = PetscSqrtReal((PetscReal)eps->n)*PETSC_MACHINE_EPSILON/2;
374:   delta = PETSC_SQRT_MACHINE_EPSILON/PetscSqrtReal((PetscReal)eps->ncv);
375:   eta = pow(PETSC_MACHINE_EPSILON,3.0/4.0)/PetscSqrtReal((PetscReal)eps->ncv);
376:   if (anorm < 0.0) {
377:     anorm = 1.0;
378:     estimate_anorm = PETSC_TRUE;
379:   }
380:   for (i=0;i<m-k;i++)
381:     omega[i] = omega_old[i] = 0.0;
382:   for (i=0;i<k;i++)
383:     which[i] = PETSC_TRUE;
384: 
385:   for (j=k;j<m;j++) {
386:     STApply(eps->OP,V[j],f);
387:     if (fro) {
388:       /* Lanczos step with full reorthogonalization */
389:       IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,PETSC_NULL,V,f,hwork,&norm,breakdown);
390:       alpha[j-k] = PetscRealPart(hwork[j]);
391:     } else {
392:       /* Lanczos step */
393:       which[j] = PETSC_TRUE;
394:       if (j-2>=k) which[j-2] = PETSC_FALSE;
395:       IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,which,V,f,hwork,&norm,breakdown);
396:       alpha[j-k] = PetscRealPart(hwork[j]);
397:       beta[j-k] = norm;
398: 
399:       /* Estimate ||A|| if needed */
400:       if (estimate_anorm) {
401:         if (j>k) anorm = PetscMax(anorm,PetscAbsReal(alpha[j-k])+norm+beta[j-k-1]);
402:         else anorm = PetscMax(anorm,PetscAbsReal(alpha[j-k])+norm);
403:       }

405:       /* Check if reorthogonalization is needed */
406:       reorth = PETSC_FALSE;
407:       if (j>k) {
408:         update_omega(omega,omega_old,j-k,alpha,beta-1,eps1,anorm);
409:         for (i=0;i<j-k;i++)
410:           if (PetscAbsScalar(omega[i]) > delta) reorth = PETSC_TRUE;
411:       }

413:       if (reorth || force_reorth) {
414:         if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_PERIODIC) {
415:           /* Periodic reorthogonalization */
416:           if (force_reorth) force_reorth = PETSC_FALSE;
417:           else force_reorth = PETSC_TRUE;
418:           IPOrthogonalize(eps->ip,0,PETSC_NULL,j-k,PETSC_NULL,V+k,f,hwork,&norm,breakdown);
419:           for (i=0;i<j-k;i++)
420:             omega[i] = eps1;
421:         } else {
422:           /* Partial reorthogonalization */
423:           if (force_reorth) force_reorth = PETSC_FALSE;
424:           else {
425:             force_reorth = PETSC_TRUE;
426:             compute_int(which2,omega,j-k,delta,eta);
427:             for (i=0;i<j-k;i++)
428:               if (which2[i]) omega[i] = eps1;
429:           }
430:           IPOrthogonalize(eps->ip,0,PETSC_NULL,j-k,which2,V+k,f,hwork,&norm,breakdown);
431:         }
432:       }
433:     }
434: 
435:     if (*breakdown || norm < eps->n*anorm*PETSC_MACHINE_EPSILON) {
436:       *M = j+1;
437:       break;
438:     }
439:     if (!fro && norm*delta < anorm*eps1) {
440:       fro = PETSC_TRUE;
441:       PetscInfo1(eps,"Switching to full reorthogonalization at iteration %D\n",eps->its);
442:     }
443: 
444:     beta[j-k] = norm;
445:     if (j<m-1) {
446:       VecScale(f,1.0/norm);
447:       VecCopy(f,V[j+1]);
448:     }
449:   }

451:   if (m>100) {
452:     PetscFree(omega);
453:     PetscFree(omega_old);
454:     PetscFree(which);
455:     PetscFree(which2);
456:     PetscFree(hwork);
457:   }
458:   return(0);
459: }

463: /*
464:    EPSBasicLanczos - Computes an m-step Lanczos factorization. The first k
465:    columns are assumed to be locked and therefore they are not modified. On
466:    exit, the following relation is satisfied:

468:                     OP * V - V * T = f * e_m^T

470:    where the columns of V are the Lanczos vectors, T is a tridiagonal matrix, 
471:    f is the residual vector and e_m is the m-th vector of the canonical basis. 
472:    The Lanczos vectors (together with vector f) are B-orthogonal (to working
473:    accuracy) if full reorthogonalization is being used, otherwise they are
474:    (B-)semi-orthogonal. On exit, beta contains the B-norm of f and the next 
475:    Lanczos vector can be computed as v_{m+1} = f / beta. 

477:    This function simply calls another function which depends on the selected
478:    reorthogonalization strategy.
479: */
480: static PetscErrorCode EPSBasicLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,Vec *V,PetscInt k,PetscInt *m,Vec f,PetscBool *breakdown,PetscReal anorm)
481: {
482:   EPS_LANCZOS        *lanczos = (EPS_LANCZOS *)eps->data;
483:   PetscScalar        *T;
484:   PetscInt           i,n=*m;
485:   PetscReal          betam;
486:   PetscErrorCode     ierr;
487:   IPOrthogRefineType orthog_ref;

490:   switch (lanczos->reorthog) {
491:     case EPS_LANCZOS_REORTHOG_LOCAL:
492:       EPSLocalLanczos(eps,alpha,beta,V,k,m,f,breakdown);
493:       break;
494:     case EPS_LANCZOS_REORTHOG_SELECTIVE:
495:       EPSSelectiveLanczos(eps,alpha,beta,V,k,m,f,breakdown,anorm);
496:       break;
497:     case EPS_LANCZOS_REORTHOG_FULL:
498:       EPSFullLanczos(eps,alpha,beta,V,k,m,f,breakdown);
499:       break;
500:     case EPS_LANCZOS_REORTHOG_PARTIAL:
501:     case EPS_LANCZOS_REORTHOG_PERIODIC:
502:       EPSPartialLanczos(eps,alpha,beta,V,k,m,f,breakdown,anorm);
503:       break;
504:     case EPS_LANCZOS_REORTHOG_DELAYED:
505:       PetscMalloc(n*n*sizeof(PetscScalar),&T);
506:       IPGetOrthogonalization(eps->ip,PETSC_NULL,&orthog_ref,PETSC_NULL);
507:       if (orthog_ref == IP_ORTHOG_REFINE_NEVER) {
508:         EPSDelayedArnoldi1(eps,T,n,V,k,m,f,&betam,breakdown);
509:       } else {
510:         EPSDelayedArnoldi(eps,T,n,V,k,m,f,&betam,breakdown);
511:       }
512:       for (i=k;i<n-1;i++) { alpha[i-k] = PetscRealPart(T[n*i+i]); beta[i-k] = PetscRealPart(T[n*i+i+1]); }
513:       alpha[n-1] = PetscRealPart(T[n*(n-1)+n-1]);
514:       beta[n-1] = betam;
515:       PetscFree(T);
516:       break;
517:     default:
518:       SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid reorthogonalization type");
519:   }
520:   return(0);
521: }

525: PetscErrorCode EPSSolve_Lanczos(EPS eps)
526: {
527:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;
529:   PetscInt       nconv,i,j,k,l,x,n,m,*perm,restart,ncv=eps->ncv,r;
530:   Vec            w=eps->work[1],f=eps->work[0];
531:   PetscScalar    *Y,stmp;
532:   PetscReal      *d,*e,*ritz,*bnd,anorm,beta,norm,rtmp,resnorm;
533:   PetscBool      breakdown;
534:   char           *conv,ctmp;

537:   PetscMalloc(ncv*sizeof(PetscReal),&d);
538:   PetscMalloc(ncv*sizeof(PetscReal),&e);
539:   PetscMalloc(ncv*sizeof(PetscReal),&ritz);
540:   PetscMalloc(ncv*ncv*sizeof(PetscScalar),&Y);
541:   PetscMalloc(ncv*sizeof(PetscReal),&bnd);
542:   PetscMalloc(ncv*sizeof(PetscInt),&perm);
543:   PetscMalloc(ncv*sizeof(char),&conv);

545:   /* The first Lanczos vector is the normalized initial vector */
546:   EPSGetStartVector(eps,0,eps->V[0],PETSC_NULL);
547: 
548:   anorm = -1.0;
549:   nconv = 0;
550: 
551:   /* Restart loop */
552:   while (eps->reason == EPS_CONVERGED_ITERATING) {
553:     eps->its++;
554:     /* Compute an ncv-step Lanczos factorization */
555:     m = PetscMin(nconv+eps->mpd,ncv);
556:     EPSBasicLanczos(eps,d,e,eps->V,nconv,&m,f,&breakdown,anorm);

558:     /* Compute eigenvalues and eigenvectors Y of the tridiagonal block */
559:     n = m - nconv;
560:     beta = e[n-1];
561:     EPSDenseTridiagonal(n,d,e,ritz,Y);
562: 
563:     /* Estimate ||A|| */
564:     for (i=0;i<n;i++)
565:       if (PetscAbsReal(ritz[i]) > anorm) anorm = PetscAbsReal(ritz[i]);
566: 
567:     /* Compute residual norm estimates as beta*abs(Y(m,:)) + eps*||A|| */
568:     for (i=0;i<n;i++) {
569:       resnorm = beta*PetscAbsScalar(Y[i*n+n-1]) + PETSC_MACHINE_EPSILON*anorm;
570:       (*eps->conv_func)(eps,ritz[i],eps->eigi[i],resnorm,&bnd[i],eps->conv_ctx);
571:       if (bnd[i]<eps->tol) {
572:         conv[i] = 'C';
573:       } else {
574:         conv[i] = 'N';
575:       }
576:     }

578:     /* purge repeated ritz values */
579:     if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL)
580:       for (i=1;i<n;i++)
581:         if (conv[i] == 'C')
582:           if (PetscAbsScalar((ritz[i]-ritz[i-1])/ritz[i]) < eps->tol)
583:             conv[i] = 'R';

585:     /* Compute restart vector */
586:     if (breakdown) {
587:       PetscInfo2(eps,"Breakdown in Lanczos method (it=%D norm=%G)\n",eps->its,beta);
588:     } else {
589:       restart = 0;
590:       while (restart<n && conv[restart] != 'N') restart++;
591:       if (restart >= n) {
592:         breakdown = PETSC_TRUE;
593:       } else {
594:         for (i=restart+1;i<n;i++)
595:           if (conv[i] == 'N') {
596:             EPSCompareEigenvalues(eps,ritz[restart],0.0,ritz[i],0.0,&r);
597:             if (r>0) restart = i;
598:           }
599:         SlepcVecMAXPBY(f,0.0,1.0,n,Y+restart*n,eps->V+nconv);
600:       }
601:     }

603:     /* Count and put converged eigenvalues first */
604:     for (i=0;i<n;i++) perm[i] = i;
605:     for (k=0;k<n;k++)
606:       if (conv[perm[k]] != 'C') {
607:         j = k + 1;
608:         while (j<n && conv[perm[j]] != 'C') j++;
609:         if (j>=n) break;
610:         l = perm[k]; perm[k] = perm[j]; perm[j] = l;
611:       }

613:     /* Sort eigenvectors according to permutation */
614:     for (i=0;i<k;i++) {
615:       x = perm[i];
616:       if (x != i) {
617:         j = i + 1;
618:         while (perm[j] != i) j++;
619:         /* swap eigenvalues i and j */
620:         rtmp = ritz[x]; ritz[x] = ritz[i]; ritz[i] = rtmp;
621:         rtmp = bnd[x]; bnd[x] = bnd[i]; bnd[i] = rtmp;
622:         ctmp = conv[x]; conv[x] = conv[i]; conv[i] = ctmp;
623:         perm[j] = x; perm[i] = i;
624:         /* swap eigenvectors i and j */
625:         for (l=0;l<n;l++) {
626:           stmp = Y[x*n+l]; Y[x*n+l] = Y[i*n+l]; Y[i*n+l] = stmp;
627:         }
628:       }
629:     }
630: 
631:     /* compute converged eigenvectors */
632:     SlepcUpdateVectors(n,eps->V+nconv,0,k,Y,n,PETSC_FALSE);
633: 
634:     /* purge spurious ritz values */
635:     if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
636:       for (i=0;i<k;i++) {
637:         VecNorm(eps->V[nconv+i],NORM_2,&norm);
638:         VecScale(eps->V[nconv+i],1.0/norm);
639:         STApply(eps->OP,eps->V[nconv+i],w);
640:         VecAXPY(w,-ritz[i],eps->V[nconv+i]);
641:         VecNorm(w,NORM_2,&norm);
642:         (*eps->conv_func)(eps,ritz[i],eps->eigi[i],norm,&bnd[i],eps->conv_ctx);
643:         if (bnd[i]>=eps->tol) conv[i] = 'S';
644:       }
645:       for (i=0;i<k;i++)
646:         if (conv[i] != 'C') {
647:           j = i + 1;
648:           while (j<k && conv[j] != 'C') j++;
649:           if (j>=k) break;
650:           /* swap eigenvalues i and j */
651:           rtmp = ritz[j]; ritz[j] = ritz[i]; ritz[i] = rtmp;
652:           rtmp = bnd[j]; bnd[j] = bnd[i]; bnd[i] = rtmp;
653:           ctmp = conv[j]; conv[j] = conv[i]; conv[i] = ctmp;
654:           /* swap eigenvectors i and j */
655:           VecSwap(eps->V[nconv+i],eps->V[nconv+j]);
656:         }
657:       k = i;
658:     }
659: 
660:     /* store ritz values and estimated errors */
661:     for (i=0;i<n;i++) {
662:       eps->eigr[nconv+i] = ritz[i];
663:       eps->errest[nconv+i] = bnd[i];
664:     }
665:     EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,nconv+n);
666:     nconv = nconv+k;
667:     if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
668:     if (nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
669: 
670:      if (eps->reason == EPS_CONVERGED_ITERATING) { /* copy restart vector */
671:       if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL && !breakdown) {
672:         /* Reorthonormalize restart vector */
673:         IPOrthogonalize(eps->ip,eps->nds,eps->DS,nconv,PETSC_NULL,eps->V,f,PETSC_NULL,&norm,&breakdown);
674:         VecScale(f,1.0/norm);
675:       }
676:       if (breakdown) {
677:         /* Use random vector for restarting */
678:         PetscInfo(eps,"Using random vector for restart\n");
679:         EPSGetStartVector(eps,nconv,f,&breakdown);
680:       }
681:       if (breakdown) { /* give up */
682:         eps->reason = EPS_DIVERGED_BREAKDOWN;
683:         PetscInfo(eps,"Unable to generate more start vectors\n");
684:       } else {
685:         VecCopy(f,eps->V[nconv]);
686:       }
687:     }
688:   }
689: 
690:   eps->nconv = nconv;

692:   PetscFree(d);
693:   PetscFree(e);
694:   PetscFree(ritz);
695:   PetscFree(Y);
696:   PetscFree(bnd);
697:   PetscFree(perm);
698:   PetscFree(conv);
699:   return(0);
700: }

704: PetscErrorCode EPSSetFromOptions_Lanczos(EPS eps)
705: {
706:   PetscErrorCode         ierr;
707:   EPS_LANCZOS            *lanczos = (EPS_LANCZOS *)eps->data;
708:   PetscBool              flg;
709:   EPSLanczosReorthogType reorthog;

712:   PetscOptionsHead("EPS Lanczos Options");
713:   PetscOptionsEnum("-eps_lanczos_reorthog","Lanczos reorthogonalization","EPSLanczosSetReorthog",EPSLanczosReorthogTypes,(PetscEnum)lanczos->reorthog,(PetscEnum*)&reorthog,&flg);
714:   if (flg) { EPSLanczosSetReorthog(eps,reorthog); }
715:   PetscOptionsTail();
716:   return(0);
717: }

719: EXTERN_C_BEGIN
722: PetscErrorCode EPSLanczosSetReorthog_Lanczos(EPS eps,EPSLanczosReorthogType reorthog)
723: {
724:   EPS_LANCZOS *lanczos = (EPS_LANCZOS *)eps->data;

727:   switch (reorthog) {
728:     case EPS_LANCZOS_REORTHOG_LOCAL:
729:     case EPS_LANCZOS_REORTHOG_FULL:
730:     case EPS_LANCZOS_REORTHOG_DELAYED:
731:     case EPS_LANCZOS_REORTHOG_SELECTIVE:
732:     case EPS_LANCZOS_REORTHOG_PERIODIC:
733:     case EPS_LANCZOS_REORTHOG_PARTIAL:
734:       lanczos->reorthog = reorthog;
735:       break;
736:     default:
737:       SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid reorthogonalization type");
738:   }
739:   return(0);
740: }
741: EXTERN_C_END

745: /*@
746:    EPSLanczosSetReorthog - Sets the type of reorthogonalization used during the Lanczos
747:    iteration. 

749:    Logically Collective on EPS

751:    Input Parameters:
752: +  eps - the eigenproblem solver context
753: -  reorthog - the type of reorthogonalization

755:    Options Database Key:
756: .  -eps_lanczos_reorthog - Sets the reorthogonalization type (either 'local', 'selective',
757:                          'periodic', 'partial', 'full' or 'delayed')
758:    
759:    Level: advanced

761: .seealso: EPSLanczosGetReorthog(), EPSLanczosReorthogType
762: @*/
763: PetscErrorCode EPSLanczosSetReorthog(EPS eps,EPSLanczosReorthogType reorthog)
764: {

770:   PetscTryMethod(eps,"EPSLanczosSetReorthog_C",(EPS,EPSLanczosReorthogType),(eps,reorthog));
771:   return(0);
772: }

774: EXTERN_C_BEGIN
777: PetscErrorCode EPSLanczosGetReorthog_Lanczos(EPS eps,EPSLanczosReorthogType *reorthog)
778: {
779:   EPS_LANCZOS *lanczos = (EPS_LANCZOS *)eps->data;

782:   *reorthog = lanczos->reorthog;
783:   return(0);
784: }
785: EXTERN_C_END

789: /*@C
790:    EPSLanczosGetReorthog - Gets the type of reorthogonalization used during the Lanczos
791:    iteration. 

793:    Not Collective

795:    Input Parameter:
796: .  eps - the eigenproblem solver context

798:    Input Parameter:
799: .  reorthog - the type of reorthogonalization

801:    Level: advanced

803: .seealso: EPSLanczosSetReorthog(), EPSLanczosReorthogType
804: @*/
805: PetscErrorCode EPSLanczosGetReorthog(EPS eps,EPSLanczosReorthogType *reorthog)
806: {

812:   PetscTryMethod(eps,"EPSLanczosGetReorthog_C",(EPS,EPSLanczosReorthogType*),(eps,reorthog));
813:   return(0);
814: }

818: PetscErrorCode EPSReset_Lanczos(EPS eps)
819: {
821:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;

824:   VecDestroyVecs(eps->ncv,&lanczos->AV);
825:   EPSReset_Default(eps);
826:   return(0);
827: }

831: PetscErrorCode EPSDestroy_Lanczos(EPS eps)
832: {

836:   PetscFree(eps->data);
837:   PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSLanczosSetReorthog_C","",PETSC_NULL);
838:   PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSLanczosGetReorthog_C","",PETSC_NULL);
839:   return(0);
840: }

844: PetscErrorCode EPSView_Lanczos(EPS eps,PetscViewer viewer)
845: {
847:   EPS_LANCZOS    *lanczos = (EPS_LANCZOS *)eps->data;
848:   PetscBool      isascii;

851:   PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
852:   if (!isascii) {
853:     SETERRQ1(((PetscObject)eps)->comm,1,"Viewer type %s not supported for EPS Lanczos",((PetscObject)viewer)->type_name);
854:   }
855:   PetscViewerASCIIPrintf(viewer,"  Lanczos: %s reorthogonalization\n",EPSLanczosReorthogTypes[lanczos->reorthog]);
856:   return(0);
857: }

859: EXTERN_C_BEGIN
862: PetscErrorCode EPSCreate_Lanczos(EPS eps)
863: {

867:   PetscNewLog(eps,EPS_LANCZOS,&eps->data);
868:   eps->ops->setup                = EPSSetUp_Lanczos;
869:   eps->ops->setfromoptions       = EPSSetFromOptions_Lanczos;
870:   eps->ops->destroy              = EPSDestroy_Lanczos;
871:   eps->ops->reset                = EPSReset_Lanczos;
872:   eps->ops->view                 = EPSView_Lanczos;
873:   eps->ops->backtransform        = EPSBackTransform_Default;
874:   eps->ops->computevectors       = EPSComputeVectors_Hermitian;
875:   PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSLanczosSetReorthog_C","EPSLanczosSetReorthog_Lanczos",EPSLanczosSetReorthog_Lanczos);
876:   PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSLanczosGetReorthog_C","EPSLanczosGetReorthog_Lanczos",EPSLanczosGetReorthog_Lanczos);
877:   return(0);
878: }
879: EXTERN_C_END