Actual source code: ks-slice.c
1: /*
3: SLEPc eigensolver: "krylovschur"
5: Method: Krylov-Schur with spectrum slicing for symmetric eigenproblems
7: References:
9: [1] R.G. Grimes et al., "A shifted block Lanczos algorithm for solving
10: sparse symmetric generalized eigenproblems", SIAM J. Matrix Analysis
11: and App., 15(1), pp. 228–272, 1994.
13: [2] G.W. Stewart, "A Krylov-Schur Algorithm for Large Eigenproblems",
14: SIAM J. Matrix Analysis and App., 23(3), pp. 601-614, 2001.
16: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
17: SLEPc - Scalable Library for Eigenvalue Problem Computations
18: Copyright (c) 2002-2011, Universitat Politecnica de Valencia, Spain
20: This file is part of SLEPc.
22: SLEPc is free software: you can redistribute it and/or modify it under the
23: terms of version 3 of the GNU Lesser General Public License as published by
24: the Free Software Foundation.
26: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
27: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
28: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
29: more details.
31: You should have received a copy of the GNU Lesser General Public License
32: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
33: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
34: */
36: #include <private/epsimpl.h> /*I "slepceps.h" I*/
37: #include <slepcblaslapack.h>
39: extern PetscErrorCode EPSProjectedKSSym(EPS,PetscInt,PetscInt,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscReal*,PetscInt*);
42: /* Type of data characterizing a shift (place from where an eps is applied) */
43: struct _n_shift{
44: PetscReal value;
45: PetscInt inertia;
46: PetscBool comp[2]; /* Shows completion of subintervals (left and right) */
47: struct _n_shift* neighb[2];/* Adjacent shifts */
48: PetscInt index;/* Index in eig where found values are stored */
49: PetscInt neigs; /* Number of values found */
50: PetscReal ext[2]; /* Limits for accepted values */
51: PetscInt nsch[2]; /* Number of missing values for each subinterval */
52: PetscInt nconv[2]; /* Converged on each side (accepted or not)*/
53: };
54: typedef struct _n_shift *shift;
56: /* Type of data for storing the state of spectrum slicing*/
57: struct _n_SR{
58: PetscReal int0,int1; /* Extremes of the interval */
59: PetscInt dir; /* Determines the order of values in eig (+1 incr, -1 decr) */
60: PetscBool hasEnd; /* Tells whether the interval has an end */
61: PetscInt inertia0,inertia1;
62: Vec *V;
63: PetscScalar *eig,*eigi,*monit,*back;
64: PetscReal *errest;
65: PetscInt *perm;/* Permutation for keeping the eigenvalues in order */
66: PetscInt numEigs; /* Number of eigenvalues in the interval */
67: PetscInt indexEig;
68: shift sPres; /* Present shift */
69: shift *pending;/* Pending shifts array */
70: PetscInt nPend;/* Number of pending shifts */
71: PetscInt maxPend;/* Size of "pending" array */
72: Vec *VDef; /* Vector for deflation */
73: PetscInt *idxDef;/* For deflation */
74: PetscInt nMAXCompl;
75: PetscInt iterCompl;
76: PetscInt itsKs; /* Krylovschur restarts */
77: PetscInt nleap;
78: shift s0;/* Initial shift */
79: };
80: typedef struct _n_SR *SR;
82: /*
83: Fills the fields of a shift structure
85: */
88: static PetscErrorCode EPSCreateShift(EPS eps,PetscReal val, shift neighb0,shift neighb1)
89: {
90: PetscErrorCode ierr;
91: shift s,*pending2;
92: PetscInt i;
93: SR sr;
96: sr = (SR)(eps->data);
97: PetscMalloc(sizeof(struct _n_shift),&s);
98: s->value = val;
99: s->neighb[0] = neighb0;
100: if(neighb0) neighb0->neighb[1] = s;
101: s->neighb[1] = neighb1;
102: if(neighb1) neighb1->neighb[0] = s;
103: s->comp[0] = PETSC_FALSE;
104: s->comp[1] = PETSC_FALSE;
105: s->index = -1;
106: s->neigs = 0;
107: s->nconv[0] = s->nconv[1] = 0;
108: s->nsch[0] = s->nsch[1]=0;
109: /* Inserts in the stack of pending shifts */
110: /* If needed, the array is resized */
111: if(sr->nPend >= sr->maxPend){
112: sr->maxPend *= 2;
113: PetscMalloc((sr->maxPend)*sizeof(shift),&pending2);
114: for(i=0;i < sr->nPend; i++)pending2[i] = sr->pending[i];
115: PetscFree(sr->pending);
116: sr->pending = pending2;
117: }
118: sr->pending[sr->nPend++]=s;
119: return(0);
120: }
122: /* Provides next shift to be computed */
125: static PetscErrorCode EPSExtractShift(EPS eps){
126: PetscErrorCode ierr;
127: PetscInt iner;
128: Mat F;
129: PC pc;
130: KSP ksp;
131: SR sr;
134: sr = (SR)(eps->data);
135: if(sr->nPend > 0){
136: sr->sPres = sr->pending[--sr->nPend];
137: STSetShift(eps->OP, sr->sPres->value);
138: STGetKSP(eps->OP, &ksp);
139: KSPGetPC(ksp, &pc);
140: PCFactorGetMatrix(pc,&F);
141: MatGetInertia(F,&iner,PETSC_NULL,PETSC_NULL);
142: sr->sPres->inertia = iner;
143: eps->target = sr->sPres->value;
144: eps->nconv = 0;
145: eps->reason = EPS_CONVERGED_ITERATING;
146: eps->its = 0;
147: }else sr->sPres = PETSC_NULL;
148: return(0);
149: }
150:
151: /*
152: Symmetric KrylovSchur adapted to spectrum slicing:
153: Allows searching an specific amount of eigenvalues in the subintervals left and right.
154: Returns whether the search has succeeded
155: */
158: static PetscErrorCode EPSKrylovSchur_Slice(EPS eps)
159: {
161: PetscInt i,conv,k,l,lds,lt,nv,m,*iwork,p,j;
162: Vec u=eps->work[0];
163: PetscScalar *Q,nu,rtmp;
164: PetscReal *a,*b,*work,beta;
165: PetscBool breakdown;
166: PetscInt count0,count1;
167: PetscReal theta,lambda;
168: shift sPres;
169: PetscBool complIterating,iscayley;/* Shows whether iterations are made for completion */
170: PetscBool sch0,sch1;/* Shows whether values are looked after on each side */
171: PetscInt iterCompl=0,n0,n1,aux,auxc;
172: SR sr;
175: /* Spectrum slicing data */
176: sr = (SR)eps->data;
177: sPres = sr->sPres;
178: complIterating =PETSC_FALSE;
179: sch1 = sch0 = PETSC_TRUE;
180: lds = PetscMin(eps->mpd,eps->ncv);
181: PetscMalloc(lds*lds*sizeof(PetscReal),&work);
182: PetscMalloc(lds*lds*sizeof(PetscScalar),&Q);
183: PetscMalloc(2*lds*sizeof(PetscInt),&iwork);
184: lt = PetscMin(eps->nev+eps->mpd,eps->ncv);
185: PetscMalloc(lt*sizeof(PetscReal),&a);
186: PetscMalloc(lt*sizeof(PetscReal),&b);
187: count0=0;count1=0; /* Found on both sides */
189: /* filling in values for the monitor */
190: PetscTypeCompare((PetscObject)eps->OP,STCAYLEY,&iscayley);
191: if(iscayley){
192: STCayleyGetAntishift(eps->OP,&nu);
193: for(i=0;i<sr->indexEig;i++){
194: sr->monit[i]=(nu + sr->eig[i])/(sr->eig[i] - sPres->value);
195: }
196: }else{
197: for(i=0;i<sr->indexEig;i++){
198: sr->monit[i]=1.0/(sr->eig[i] - sPres->value);
199: }
200: }
201:
202:
203: /* Get the starting Lanczos vector */
204: EPSGetStartVector(eps,0,eps->V[0],PETSC_NULL);
205: l = 0;
207: /* Restart loop */
208: while (eps->reason == EPS_CONVERGED_ITERATING) {
209: eps->its++; sr->itsKs++;
210: /* Compute an nv-step Lanczos factorization */
211: m = PetscMin(eps->nconv+eps->mpd,eps->ncv);
213: EPSFullLanczos(eps,a+l,b+l,eps->V,eps->nconv+l,&m,u,&breakdown);
214: nv = m - eps->nconv;
215: beta = b[nv-1];
217: /* Solve projected problem and compute residual norm estimates */
218: EPSProjectedKSSym(eps,nv,l,a,b,eps->eigr+eps->nconv,Q,work,iwork);
219: /* Residual */
220: EPSKrylovConvergence(eps,PETSC_TRUE,PETSC_TRUE,eps->nconv,nv,PETSC_NULL,nv,Q,eps->V+eps->nconv,nv,beta,1.0,&k,PETSC_NULL);
221: /* Check convergence */
222: conv=k=j=0;
223: for(i=0;i<nv;i++)if(eps->errest[eps->nconv+i] < eps->tol)conv++;
224: for(i=0;i<nv;i++){
225: if(eps->errest[eps->nconv+i] < eps->tol){
226: iwork[j++]=i;
227: }else iwork[conv+k++]=i;
228: }
229: for(i=0;i<nv;i++){
230: a[i]=PetscRealPart(eps->eigr[eps->nconv+i]);
231: b[i]=eps->errest[eps->nconv+i];
232: }
233: for(i=0;i<nv;i++){
234: eps->eigr[eps->nconv+i] = a[iwork[i]];
235: eps->errest[eps->nconv+i] = b[iwork[i]];
236: }
237: for( i=0;i<nv;i++){
238: p=iwork[i];
239: if(p!=i){
240: j=i+1;
241: while(iwork[j]!=i)j++;
242: iwork[j]=p;iwork[i]=i;
243: for(k=0;k<nv;k++){
244: rtmp=Q[k+p*nv];Q[k+p*nv]=Q[k+i*nv];Q[k+i*nv]=rtmp;
245: }
246: }
247: }
248: k=eps->nconv+conv;
249: /* Checking values obtained for completing */
250: for(i=0;i<k;i++){
251: sr->back[i]=eps->eigr[i];
252: }
253: STBackTransform(eps->OP,k,sr->back,eps->eigi);
254: count0=count1=0;
255: for(i=0;i<k;i++){
256: theta = PetscRealPart(eps->eigr[i]);
257: lambda = PetscRealPart(sr->back[i]);
258: if( ((sr->dir)*theta < 0) && ((sr->dir)*(lambda - sPres->ext[0]) > 0))count0++;
259: if( ((sr->dir)*theta > 0) && ((sr->dir)*(sPres->ext[1] - lambda) > 0))count1++;
260: }
261:
262: /* Checks completion */
263: if( (!sch0||count0 >= sPres->nsch[0]) && (!sch1 ||count1 >= sPres->nsch[1]) ) {
264: eps->reason = EPS_CONVERGED_TOL;
265: }else {
266: if(!complIterating && eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
267: if(complIterating){
268: if(--iterCompl <= 0) eps->reason = EPS_DIVERGED_ITS;
269: }else if (k >= eps->nev) {
270: n0 = sPres->nsch[0]-count0;
271: n1 = sPres->nsch[1]-count1;
272: if( sr->iterCompl>0 && ( (n0>0&& n0<= sr->nMAXCompl)||(n1>0&&n1<=sr->nMAXCompl) )){
273: /* Iterating for completion*/
274: complIterating = PETSC_TRUE;
275: if(n0 >sr->nMAXCompl)sch0 = PETSC_FALSE;
276: if(n1 >sr->nMAXCompl)sch1 = PETSC_FALSE;
277: iterCompl = sr->iterCompl;
278: }else eps->reason = EPS_CONVERGED_TOL;
279: }
280: }
281:
282: /* Update l */
283: if (eps->reason != EPS_CONVERGED_ITERATING || breakdown) l = 0;
284: else l = (eps->nconv+nv-k)/2;
286: if (eps->reason == EPS_CONVERGED_ITERATING) {
287: if (breakdown) {
288: /* Start a new Lanczos factorization */
289: PetscInfo2(eps,"Breakdown in Krylov-Schur method (it=%D norm=%G)\n",eps->its,beta);
290: EPSGetStartVector(eps,k,eps->V[k],&breakdown);
291: if (breakdown) {
292: eps->reason = EPS_DIVERGED_BREAKDOWN;
293: PetscInfo(eps,"Unable to generate more start vectors\n");
294: }
295: } else {
296: /* Prepare the Rayleigh quotient for restart */
297: for (i=0;i<l;i++) {
298: a[i] = PetscRealPart(eps->eigr[i+k]);
299: b[i] = PetscRealPart(Q[nv-1+(i+k-eps->nconv)*nv]*beta);
300: }
301: }
302: }
303: /* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
304: SlepcUpdateVectors(nv,eps->V+eps->nconv,0,k+l-eps->nconv,Q,nv,PETSC_FALSE);
305: /* Normalize u and append it to V */
306: if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
307: VecAXPBY(eps->V[k+l],1.0/beta,0.0,u);
308: }
309: if(eps->numbermonitors >0){
310: aux = auxc = 0;
311: for(i=0;i<nv+eps->nconv;i++){
312: sr->back[i]=eps->eigr[i];
313: }
314: STBackTransform(eps->OP,nv+eps->nconv,sr->back,eps->eigi);
315: for(i=0;i<nv+eps->nconv;i++){
316: lambda = PetscRealPart(sr->back[i]);
317: if( ((sr->dir)*(lambda - sPres->ext[0]) > 0)&& ((sr->dir)*(sPres->ext[1] - lambda) > 0)){
318: sr->monit[sr->indexEig+aux]=eps->eigr[i];
319: sr->errest[sr->indexEig+aux]=eps->errest[i];
320: aux++;
321: if(eps->errest[i] < eps->tol)auxc++;
322: }
323: }
324: EPSMonitor(eps,eps->its,auxc+sr->indexEig,sr->monit,sr->eigi,sr->errest,sr->indexEig+aux);
325: }
326: eps->nconv = k;
327: }
328: /* Check for completion */
329: for(i=0;i< eps->nconv; i++){
330: if( (sr->dir)*PetscRealPart(eps->eigr[i])>0 )sPres->nconv[1]++;
331: else sPres->nconv[0]++;
332: }
333: sPres->comp[0] = (count0 >= sPres->nsch[0])?PETSC_TRUE:PETSC_FALSE;
334: sPres->comp[1] = (count1 >= sPres->nsch[1])?PETSC_TRUE:PETSC_FALSE;
335: if(count0 > sPres->nsch[0] || count1 > sPres->nsch[1])SETERRQ(((PetscObject)eps)->comm,1,"Unexpected error in Spectrum Slicing!\nMismatch between number of values found and information from inertia");
337: PetscFree(Q);
338: PetscFree(a);
339: PetscFree(b);
340: PetscFree(work);
341: PetscFree(iwork);
342: return(0);
343: }
345: /*
346: Obtains value of subsequent shift
347: */
350: static PetscErrorCode EPSGetNewShiftValue(EPS eps,PetscInt side,PetscReal *newS){
351: PetscReal lambda,d_prev;
352: PetscInt i,idxP;
353: SR sr;
354: shift sPres,s;
357: sr = (SR)eps->data;
358: sPres = sr->sPres;
359: if( sPres->neighb[side]){
360: /* Completing a previous interval */
361: if(!sPres->neighb[side]->neighb[side] && sPres->neighb[side]->nconv[side]==0){ /* One of the ends might be too far from eigenvalues */
362: if(side) *newS = (sPres->value + PetscRealPart(sr->eig[sr->perm[sr->indexEig-1]]))/2;
363: else *newS = (sPres->value + PetscRealPart(sr->eig[sr->perm[0]]))/2;
364: }else *newS=(sPres->value + sPres->neighb[side]->value)/2;
365: }else{ /* (Only for side=1). Creating a new interval. */
366: if(sPres->neigs==0){/* No value has been accepted*/
367: if(sPres->neighb[0]){
368: /* Multiplying by 10 the previous distance */
369: *newS = sPres->value + 10*(sr->dir)*PetscAbsReal(sPres->value - sPres->neighb[0]->value);
370: sr->nleap++;
371: /* Stops when the interval is open and no values are found in the last 5 shifts (there might be infinite eigenvalues) */
372: if( !sr->hasEnd && sr->nleap > 5)SETERRQ(((PetscObject)eps)->comm,1,"Unable to compute the wanted eigenvalues with open interval");
373: }else {/* First shift */
374: if(eps->nconv != 0){
375: /* Unaccepted values give information for next shift */
376: idxP=0;/* Number of values left from shift */
377: for(i=0;i<eps->nconv;i++){
378: lambda = PetscRealPart(eps->eigr[i]);
379: if( (sr->dir)*(lambda - sPres->value) <0)idxP++;
380: else break;
381: }
382: /* Avoiding subtraction of eigenvalues (might be the same).*/
383: if(idxP>0){
384: d_prev = PetscAbsReal(sPres->value - PetscRealPart(eps->eigr[0]))/(idxP+0.3);
385: }else {
386: d_prev = PetscAbsReal(sPres->value - PetscRealPart(eps->eigr[eps->nconv-1]))/(eps->nconv+0.3);
387: }
388: *newS = sPres->value + ((sr->dir)*d_prev*eps->nev)/2;
389: }else{/* No values found, no information for next shift */
390: SETERRQ(((PetscObject)eps)->comm,1,"First shift renders no information");
391: }
392: }
393: }else{/* Accepted values found */
394: sr->nleap = 0;
395: /* Average distance of values in previous subinterval */
396: s = sPres->neighb[0];
397: while(s && PetscAbs(s->inertia - sPres->inertia)==0){
398: s = s->neighb[0];/* Looking for previous shifts with eigenvalues within */
399: }
400: if(s){
401: d_prev = PetscAbsReal( (sPres->value - s->value)/(sPres->inertia - s->inertia));
402: }else{/* First shift. Average distance obtained with values in this shift */
403: /* first shift might be too far from first wanted eigenvalue (no values found outside the interval)*/
404: if( (sr->dir)*(PetscRealPart(sr->eig[0])-sPres->value)>0 && PetscAbsReal( (PetscRealPart(sr->eig[sr->indexEig-1]) - PetscRealPart(sr->eig[0]))/PetscRealPart(sr->eig[0])) > PetscSqrtReal(eps->tol) ){
405: d_prev = PetscAbsReal( (PetscRealPart(sr->eig[sr->indexEig-1]) - PetscRealPart(sr->eig[0])))/(sPres->neigs+0.3);
406: }else{
407: d_prev = PetscAbsReal( PetscRealPart(sr->eig[sr->indexEig-1]) - sPres->value)/(sPres->neigs+0.3);
408: }
409: }
410: /* Average distance is used for next shift by adding it to value on the right or to shift */
411: if( (sr->dir)*(PetscRealPart(sr->eig[sPres->index + sPres->neigs -1]) - sPres->value) >0){
412: *newS = PetscRealPart(sr->eig[sPres->index + sPres->neigs -1])+ ((sr->dir)*d_prev*(eps->nev))/2;
413: }else{/* Last accepted value is on the left of shift. Adding to shift */
414: *newS = sPres->value + ((sr->dir)*d_prev*(eps->nev))/2;
415: }
416: }
417: /* End of interval can not be surpassed */
418: if((sr->dir)*( sr->int1 - *newS) < 0) *newS = sr->int1;
419: }/* of neighb[side]==null */
420: return(0);
421: }
423: /*
424: Function for sorting an array of real values
425: */
428: static PetscErrorCode sortRealEigenvalues(PetscScalar *r,PetscInt *perm,PetscInt nr,PetscBool prev,PetscInt dir)
429: {
430: PetscReal re;
431: PetscInt i,j,tmp;
432:
434: if(!prev) for (i=0; i < nr; i++) { perm[i] = i; }
435: /* Insertion sort */
436: for (i=1; i < nr; i++) {
437: re = PetscRealPart(r[perm[i]]);
438: j = i-1;
439: while ( j>=0 && dir*(re - PetscRealPart(r[perm[j]])) <= 0 ) {
440: tmp = perm[j]; perm[j] = perm[j+1]; perm[j+1] = tmp; j--;
441: }
442: }
443: return(0);
444: }
446: /* Stores the pairs obtained since the last shift in the global arrays */
449: PetscErrorCode EPSStoreEigenpairs(EPS eps)
450: {
452: PetscReal lambda,err,norm;
453: PetscInt i,count;
454: PetscBool iscayley;
455: SR sr;
456: shift sPres;
459: sr = (SR)(eps->data);
460: sPres = sr->sPres;
461: sPres->index = sr->indexEig;
462: count = sr->indexEig;
463: /* Backtransform */
464: EPSBackTransform_Default(eps);
465: PetscTypeCompare((PetscObject)eps->OP,STCAYLEY,&iscayley);
466: /* Sort eigenvalues */
467: sortRealEigenvalues(eps->eigr,eps->perm,eps->nconv,PETSC_FALSE,sr->dir);
468: /* Values stored in global array */
469: for( i=0; i < eps->nconv ;i++ ){
470: lambda = PetscRealPart(eps->eigr[eps->perm[i]]);
471: err = eps->errest[eps->perm[i]];
472: if( (sr->dir)*(lambda - sPres->ext[0]) > 0 && (sr->dir)*(sPres->ext[1] - lambda) > 0 ){/* Valid value */
473: if(count>=sr->numEigs){/* Error found */
474: SETERRQ(((PetscObject)eps)->comm,1,"Unexpected error in Spectrum Slicing!");
475: }
476: sr->eig[count] = lambda;
477: sr->errest[count] = err;
478: /* Purification */
479: if (eps->isgeneralized && !iscayley){
480: STApply(eps->OP,eps->V[eps->perm[i]],sr->V[count]);
481: IPNorm(eps->ip,sr->V[count],&norm);
482: VecScale(sr->V[count],1.0/norm);
483: }else{
484: VecCopy(eps->V[eps->perm[i]], sr->V[count]);
485: }
486: count++;
487: }
488: }
489: sPres->neigs = count - sr->indexEig;
490: sr->indexEig = count;
491: /* Global ordering array updating */
492: sortRealEigenvalues(sr->eig,sr->perm,count,PETSC_TRUE,sr->dir);
493: return(0);
494: }
498: PetscErrorCode EPSLookForDeflation(EPS eps)
499: {
500: PetscReal val;
501: PetscInt i,count0=0,count1=0;
502: shift sPres;
503: PetscInt ini,fin,k,idx0,idx1;
504: SR sr;
507: sr = (SR)(eps->data);
508: sPres = sr->sPres;
510: if(sPres->neighb[0]) ini = (sr->dir)*(sPres->neighb[0]->inertia - sr->inertia0);
511: else ini = 0;
512: fin = sr->indexEig;
513: /* Selection of ends for searching new values */
514: if(!sPres->neighb[0]) sPres->ext[0] = sr->int0;/* First shift */
515: else sPres->ext[0] = sPres->neighb[0]->value;
516: if(!sPres->neighb[1]) {
517: if(sr->hasEnd) sPres->ext[1] = sr->int1;
518: else sPres->ext[1] = (sr->dir > 0)?PETSC_MAX_REAL:PETSC_MIN_REAL;
519: }else sPres->ext[1] = sPres->neighb[1]->value;
520: /* Selection of values between right and left ends */
521: for(i=ini;i<fin;i++){
522: val=PetscRealPart(sr->eig[sr->perm[i]]);
523: /* Values to the right of left shift */
524: if( (sr->dir)*(val - sPres->ext[1]) < 0 ){
525: if((sr->dir)*(val - sPres->value) < 0)count0++;
526: else count1++;
527: }else break;
528: }
529: /* The number of values on each side are found */
530: if(sPres->neighb[0]){
531: sPres->nsch[0] = (sr->dir)*(sPres->inertia - sPres->neighb[0]->inertia)-count0;
532: if(sPres->nsch[0]<0)SETERRQ(((PetscObject)eps)->comm,1,"Unexpected error in Spectrum Slicing!\nMismatch between number of values found and information from inertia");
533: }else sPres->nsch[0] = 0;
535: if(sPres->neighb[1]){
536: sPres->nsch[1] = (sr->dir)*(sPres->neighb[1]->inertia - sPres->inertia) - count1;
537: if(sPres->nsch[1]<0)SETERRQ(((PetscObject)eps)->comm,1,"Unexpected error in Spectrum Slicing!\nMismatch between number of values found and information from inertia");
538: }else sPres->nsch[1] = (sr->dir)*(sr->inertia1 - sPres->inertia);
539:
540: /* Completing vector of indexes for deflation */
541: idx0 = ini;
542: idx1 = ini+count0+count1;
543: k=0;
544: for(i=idx0;i<idx1;i++)sr->idxDef[k++]=sr->perm[i];
545: for(i=0;i<k;i++)sr->VDef[i]=sr->V[sr->idxDef[i]];
546: eps->DS = sr->VDef;
547: eps->nds = k;
548: return(0);
549: }
553: PetscErrorCode EPSSolve_KrylovSchur_Slice(EPS eps)
554: {
556: PetscInt i;
557: PetscReal newS;
558: KSP ksp;
559: PC pc;
560: Mat F;
561: PetscReal *errest_left;
562: Vec t;
563: SR sr;
564: shift s;
565:
567: #if defined(PETSC_USE_COMPLEX)
568: SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Spectrum slicing not supported in complex scalars");
569: #endif
570: PetscMalloc(sizeof(struct _n_SR),&sr);
571: eps->data = sr;
572: sr->itsKs = 0;
573: sr->nleap = 0;
574: sr->nMAXCompl = eps->nev/4;
575: sr->iterCompl = eps->max_it/4;
576: /* Checking presence of ends and finding direction */
577: if( eps->inta > PETSC_MIN_REAL){
578: sr->int0 = eps->inta;
579: sr->int1 = eps->intb;
580: sr->dir = 1;
581: if(eps->intb >= PETSC_MAX_REAL){ /* Right-open interval */
582: sr->hasEnd = PETSC_FALSE;
583: sr->inertia1 = eps->n;
584: }else sr->hasEnd = PETSC_TRUE;
585: }else{ /* Left-open interval */
586: sr->int0 = eps->intb;
587: sr->int1 = eps->inta;
588: sr->dir = -1;
589: sr->hasEnd = PETSC_FALSE;
590: sr->inertia1 = 0;
591: }
592: /* Array of pending shifts */
593: sr->maxPend = 100;/* Initial size */
594: PetscMalloc((sr->maxPend)*sizeof(shift),&sr->pending);
595: if(sr->hasEnd){
596: STGetKSP(eps->OP, &ksp);
597: KSPGetPC(ksp, &pc);
598: PCFactorGetMatrix(pc,&F);
599: /* Not looking for values in b (just inertia).*/
600: MatGetInertia(F,&sr->inertia1,PETSC_NULL,PETSC_NULL);
601: PCReset(pc); /* avoiding memory leak */
602: }
603: sr->nPend = 0;
604: EPSCreateShift(eps,sr->int0,PETSC_NULL,PETSC_NULL);
605: EPSExtractShift(eps);
606: sr->s0 = sr->sPres;
607: sr->inertia0 = sr->s0->inertia;
608: sr->numEigs = (sr->dir)*(sr->inertia1 - sr->inertia0);
609: sr->indexEig = 0;
610: /* Only with eigenvalues present in the interval ...*/
611: if(sr->numEigs==0){
612: eps->reason = EPS_CONVERGED_TOL;
613: PetscFree(sr->s0);
614: PetscFree(sr->pending);
615: PetscFree(sr);
616: return(0);
617: }
618: /* Memory reservation for eig, V and perm */
619: PetscMalloc((sr->numEigs)*sizeof(PetscScalar),&sr->eig);
620: PetscMalloc((sr->numEigs)*sizeof(PetscScalar),&sr->eigi);
621: PetscMalloc((sr->numEigs+eps->ncv) *sizeof(PetscReal),&sr->errest);
622: PetscMalloc((sr->numEigs+eps->ncv)*sizeof(PetscReal),&errest_left);
623: PetscMalloc((sr->numEigs+eps->ncv)*sizeof(PetscScalar),&sr->monit);
624: PetscMalloc((eps->ncv)*sizeof(PetscScalar),&sr->back);
625: for(i=0;i<sr->numEigs;i++){sr->eigi[i]=0;sr->eig[i] = 0;}
626: for(i=0;i<sr->numEigs+eps->ncv;i++){errest_left[i]=0;sr->errest[i]=0;sr->monit[i]=0;}
627: VecCreateMPI(((PetscObject)eps)->comm,eps->nloc,PETSC_DECIDE,&t);
628: VecDuplicateVecs(t,sr->numEigs,&sr->V);
629: VecDestroy(&t);
630: /* Vector for maintaining order of eigenvalues */
631: PetscMalloc((sr->numEigs)*sizeof(PetscInt),&sr->perm);
632: for(i=0;i< sr->numEigs;i++)sr->perm[i]=i;
633: /* Vectors for deflation */
634: PetscMalloc((sr->numEigs)*sizeof(PetscInt),&sr->idxDef);
635: PetscMalloc((sr->numEigs)*sizeof(Vec),&sr->VDef);
636: sr->indexEig = 0;
638: while(sr->sPres){
639: /* Search for deflation */
640: EPSLookForDeflation(eps);
641: /* KrylovSchur */
642: EPSKrylovSchur_Slice(eps);
643:
644: EPSStoreEigenpairs(eps);
645: /* Select new shift */
646: if(!sr->sPres->comp[1]){
647: EPSGetNewShiftValue(eps,1,&newS);
648: EPSCreateShift(eps,newS,sr->sPres,sr->sPres->neighb[1]);
649: }
650: if(!sr->sPres->comp[0]){
651: /* Completing earlier interval */
652: EPSGetNewShiftValue(eps,0,&newS);
653: EPSCreateShift(eps,newS,sr->sPres->neighb[0],sr->sPres);
654: }
655: /* Preparing for a new search of values */
656: EPSExtractShift(eps);
657: }
659: /* Updating eps values prior to exit */
660:
661: VecDestroyVecs(eps->allocated_ncv,&eps->V);
662: eps->V = sr->V;
663: PetscFree(eps->eigr);
664: PetscFree(eps->eigi);
665: PetscFree(eps->errest);
666: PetscFree(eps->errest_left);
667: PetscFree(eps->perm);
668: eps->eigr = sr->eig;
669: eps->eigi = sr->eigi;
670: eps->errest = sr->errest;
671: eps->errest_left = errest_left;
672: eps->perm = sr->perm;
673: eps->ncv = eps->allocated_ncv = sr->numEigs;
674: eps->nconv = sr->indexEig;
675: eps->reason = EPS_CONVERGED_TOL;
676: eps->its = sr->itsKs;
677: eps->nds = 0;
678: eps->DS = PETSC_NULL;
679: eps->evecsavailable = PETSC_TRUE;
680: PetscFree(sr->VDef);
681: PetscFree(sr->idxDef);
682: PetscFree(sr->pending);
683: PetscFree(sr->monit);
684: PetscFree(sr->back);
685: /* Reviewing list of shifts to free memory */
686: s = sr->s0;
687: if(s){
688: while(s->neighb[1]){
689: s = s->neighb[1];
690: PetscFree(s->neighb[0]);
691: }
692: PetscFree(s);
693: }
694: PetscFree(sr);
695: return(0);
696: }