Actual source code: ciss.c

slepc-3.17.1 2022-04-11
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */
 10: /*
 11:    SLEPc eigensolver: "ciss"

 13:    Method: Contour Integral Spectral Slicing

 15:    Algorithm:

 17:        Contour integral based on Sakurai-Sugiura method to construct a
 18:        subspace, with various eigenpair extractions (Rayleigh-Ritz,
 19:        explicit moment).

 21:    Based on code contributed by Y. Maeda, T. Sakurai.

 23:    References:

 25:        [1] T. Sakurai and H. Sugiura, "A projection method for generalized
 26:            eigenvalue problems", J. Comput. Appl. Math. 159:119-128, 2003.

 28:        [2] T. Sakurai and H. Tadano, "CIRR: a Rayleigh-Ritz type method with
 29:            contour integral for generalized eigenvalue problems", Hokkaido
 30:            Math. J. 36:745-757, 2007.
 31: */

 33: #include <slepc/private/epsimpl.h>
 34: #include <slepc/private/slepccontour.h>
 35: #include <slepcblaslapack.h>

 37: typedef struct {
 38:   /* user parameters */
 39:   PetscInt          N;          /* number of integration points (32) */
 40:   PetscInt          L;          /* block size (16) */
 41:   PetscInt          M;          /* moment degree (N/4 = 4) */
 42:   PetscReal         delta;      /* threshold of singular value (1e-12) */
 43:   PetscInt          L_max;      /* maximum number of columns of the source matrix V */
 44:   PetscReal         spurious_threshold; /* discard spurious eigenpairs */
 45:   PetscBool         isreal;     /* A and B are real */
 46:   PetscInt          npart;      /* number of partitions */
 47:   PetscInt          refine_inner;
 48:   PetscInt          refine_blocksize;
 49:   EPSCISSQuadRule   quad;
 50:   EPSCISSExtraction extraction;
 51:   PetscBool         usest;
 52:   /* private data */
 53:   SlepcContourData  contour;
 54:   PetscReal         *sigma;     /* threshold for numerical rank */
 55:   PetscScalar       *weight;
 56:   PetscScalar       *omega;
 57:   PetscScalar       *pp;
 58:   BV                V;
 59:   BV                S;
 60:   BV                pV;
 61:   BV                Y;
 62:   PetscBool         useconj;
 63:   PetscBool         usest_set;  /* whether the user set the usest flag or not */
 64:   PetscObjectId     rgid;
 65:   PetscObjectState  rgstate;
 66: } EPS_CISS;

 68: /*
 69:   Set up KSP solvers for every integration point, only called if !ctx->usest
 70: */
 71: static PetscErrorCode EPSCISSSetUp(EPS eps,Mat A,Mat B,Mat Pa,Mat Pb)
 72: {
 73:   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
 74:   SlepcContourData contour;
 75:   PetscInt         i,p_id,nsplit;
 76:   Mat              Amat,Pmat;
 77:   MatStructure     str,strp;

 79:   if (!ctx->contour || !ctx->contour->ksp) EPSCISSGetKSPs(eps,NULL,NULL);
 80:   contour = ctx->contour;
 81:   STGetMatStructure(eps->st,&str);
 82:   STGetSplitPreconditionerInfo(eps->st,&nsplit,&strp);
 83:   for (i=0;i<contour->npoints;i++) {
 84:     p_id = i*contour->subcomm->n + contour->subcomm->color;
 85:     MatDuplicate(A,MAT_COPY_VALUES,&Amat);
 86:     if (B) MatAXPY(Amat,-ctx->omega[p_id],B,str);
 87:     else MatShift(Amat,-ctx->omega[p_id]);
 88:     if (nsplit) {
 89:       MatDuplicate(Pa,MAT_COPY_VALUES,&Pmat);
 90:       if (Pb) MatAXPY(Pmat,-ctx->omega[p_id],Pb,strp);
 91:       else MatShift(Pmat,-ctx->omega[p_id]);
 92:     } else Pmat = Amat;
 93:     EPS_KSPSetOperators(contour->ksp[i],Amat,Amat);
 94:     MatDestroy(&Amat);
 95:     if (nsplit) MatDestroy(&Pmat);
 96:   }
 97:   PetscFunctionReturn(0);
 98: }

100: /*
101:   Y_i = (A-z_i B)^{-1}BV for every integration point, Y=[Y_i] is in the context
102: */
103: static PetscErrorCode EPSCISSSolve(EPS eps,Mat B,BV V,PetscInt L_start,PetscInt L_end)
104: {
105:   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
106:   SlepcContourData contour;
107:   PetscInt         i,p_id;
108:   Mat              MV,BMV=NULL,MC;
109:   KSP              ksp;

111:   if (!ctx->contour || !ctx->contour->ksp) EPSCISSGetKSPs(eps,NULL,NULL);
112:   contour = ctx->contour;
113:   BVSetActiveColumns(V,L_start,L_end);
114:   BVGetMat(V,&MV);
115:   for (i=0;i<contour->npoints;i++) {
116:     p_id = i*contour->subcomm->n + contour->subcomm->color;
117:     if (ctx->usest)  {
118:       STSetShift(eps->st,ctx->omega[p_id]);
119:       STGetKSP(eps->st,&ksp);
120:     } else ksp = contour->ksp[i];
121:     BVSetActiveColumns(ctx->Y,i*ctx->L+L_start,i*ctx->L+L_end);
122:     BVGetMat(ctx->Y,&MC);
123:     if (B) {
124:       if (!i) {
125:         MatProductCreate(B,MV,NULL,&BMV);
126:         MatProductSetType(BMV,MATPRODUCT_AB);
127:         MatProductSetFromOptions(BMV);
128:         MatProductSymbolic(BMV);
129:       }
130:       MatProductNumeric(BMV);
131:       KSPMatSolve(ksp,BMV,MC);
132:     } else KSPMatSolve(ksp,MV,MC);
133:     BVRestoreMat(ctx->Y,&MC);
134:     if (ctx->usest && i<contour->npoints-1) KSPReset(ksp);
135:   }
136:   MatDestroy(&BMV);
137:   BVRestoreMat(V,&MV);
138:   PetscFunctionReturn(0);
139: }

141: static PetscErrorCode rescale_eig(EPS eps,PetscInt nv)
142: {
143:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
144:   PetscInt       i;
145:   PetscScalar    center;
146:   PetscReal      radius,a,b,c,d,rgscale;
147: #if defined(PETSC_USE_COMPLEX)
148:   PetscReal      start_ang,end_ang,vscale,theta;
149: #endif
150:   PetscBool      isring,isellipse,isinterval;

152:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
153:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
154:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
155:   RGGetScale(eps->rg,&rgscale);
156:   if (isinterval) {
157:     RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
158:     if (c==d) {
159:       for (i=0;i<nv;i++) {
160: #if defined(PETSC_USE_COMPLEX)
161:         eps->eigr[i] = PetscRealPart(eps->eigr[i]);
162: #else
163:         eps->eigi[i] = 0;
164: #endif
165:       }
166:     }
167:   }
168:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
169:     if (isellipse) {
170:       RGEllipseGetParameters(eps->rg,&center,&radius,NULL);
171:       for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
172:     } else if (isinterval) {
173:       RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
174:       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
175:         for (i=0;i<nv;i++) {
176:           if (c==d) eps->eigr[i] = ((b-a)*(eps->eigr[i]+1.0)/2.0+a)*rgscale;
177:           if (a==b) {
178: #if defined(PETSC_USE_COMPLEX)
179:             eps->eigr[i] = ((d-c)*(eps->eigr[i]+1.0)/2.0+c)*rgscale*PETSC_i;
180: #else
181:             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
182: #endif
183:           }
184:         }
185:       } else {
186:         center = (b+a)/2.0+(d+c)/2.0*PETSC_PI;
187:         radius = PetscSqrtReal(PetscPowRealInt((b-a)/2.0,2)+PetscPowRealInt((d-c)/2.0,2));
188:         for (i=0;i<nv;i++) eps->eigr[i] = center + radius*eps->eigr[i];
189:       }
190:     } else if (isring) {  /* only supported in complex scalars */
191: #if defined(PETSC_USE_COMPLEX)
192:       RGRingGetParameters(eps->rg,&center,&radius,&vscale,&start_ang,&end_ang,NULL);
193:       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
194:         for (i=0;i<nv;i++) {
195:           theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(eps->eigr[i])+1.0))*PETSC_PI;
196:           eps->eigr[i] = rgscale*center + (rgscale*radius+PetscImaginaryPart(eps->eigr[i]))*PetscCMPLX(PetscCosReal(theta),vscale*PetscSinReal(theta));
197:         }
198:       } else {
199:         for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
200:       }
201: #endif
202:     }
203:   }
204:   PetscFunctionReturn(0);
205: }

207: PetscErrorCode EPSSetUp_CISS(EPS eps)
208: {
209:   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
210:   SlepcContourData contour;
211:   PetscBool        istrivial,isring,isellipse,isinterval,flg;
212:   PetscReal        c,d;
213:   PetscInt         nsplit;
214:   PetscRandom      rand;
215:   PetscObjectId    id;
216:   PetscObjectState state;
217:   Mat              A[2],Psplit[2];
218:   Vec              v0;

220:   if (eps->ncv==PETSC_DEFAULT) {
221:     eps->ncv = ctx->L_max*ctx->M;
222:     if (eps->ncv>eps->n) {
223:       eps->ncv = eps->n;
224:       ctx->L_max = eps->ncv/ctx->M;
226:     }
227:   } else {
228:     EPSSetDimensions_Default(eps,eps->nev,&eps->ncv,&eps->mpd);
229:     ctx->L_max = eps->ncv/ctx->M;
230:     if (!ctx->L_max) {
231:       ctx->L_max = 1;
232:       eps->ncv = ctx->L_max*ctx->M;
233:     }
234:   }
235:   ctx->L = PetscMin(ctx->L,ctx->L_max);
236:   if (eps->max_it==PETSC_DEFAULT) eps->max_it = 5;
237:   if (eps->mpd==PETSC_DEFAULT) eps->mpd = eps->ncv;
238:   if (!eps->which) eps->which = EPS_ALL;
240:   EPSCheckUnsupported(eps,EPS_FEATURE_BALANCE | EPS_FEATURE_ARBITRARY | EPS_FEATURE_EXTRACTION | EPS_FEATURE_STOPPING | EPS_FEATURE_TWOSIDED);

242:   /* check region */
243:   RGIsTrivial(eps->rg,&istrivial);
245:   RGGetComplement(eps->rg,&flg);
247:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
248:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
249:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);

252:   /* if the region has changed, then reset contour data */
253:   PetscObjectGetId((PetscObject)eps->rg,&id);
254:   PetscObjectStateGet((PetscObject)eps->rg,&state);
255:   if (ctx->rgid && (id != ctx->rgid || state != ctx->rgstate)) {
256:     SlepcContourDataDestroy(&ctx->contour);
257:     PetscInfo(eps,"Resetting the contour data structure due to a change of region\n");
258:     ctx->rgid = id; ctx->rgstate = state;
259:   }

261: #if !defined(PETSC_USE_COMPLEX)
263: #endif
264:   if (isinterval) {
265:     RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
266: #if !defined(PETSC_USE_COMPLEX)
268: #endif
269:     if (!ctx->quad && c==d) ctx->quad = EPS_CISS_QUADRULE_CHEBYSHEV;
270:   }
271:   if (!ctx->quad) ctx->quad = EPS_CISS_QUADRULE_TRAPEZOIDAL;

273:   /* create contour data structure */
274:   if (!ctx->contour) {
275:     RGCanUseConjugates(eps->rg,ctx->isreal,&ctx->useconj);
276:     SlepcContourDataCreate(ctx->useconj?ctx->N/2:ctx->N,ctx->npart,(PetscObject)eps,&ctx->contour);
277:   }

279:   EPSAllocateSolution(eps,0);
280:   BVGetRandomContext(eps->V,&rand);  /* make sure the random context is available when duplicating */
281:   if (ctx->weight) PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
282:   PetscMalloc4(ctx->N,&ctx->weight,ctx->N+1,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
283:   PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));

285:   /* allocate basis vectors */
286:   BVDestroy(&ctx->S);
287:   BVDuplicateResize(eps->V,ctx->L*ctx->M,&ctx->S);
288:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
289:   BVDestroy(&ctx->V);
290:   BVDuplicateResize(eps->V,ctx->L,&ctx->V);
291:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);

293:   STGetMatrix(eps->st,0,&A[0]);
294:   MatIsShell(A[0],&flg);
296:   if (eps->isgeneralized) STGetMatrix(eps->st,1,&A[1]);

298:   if (!ctx->usest_set) ctx->usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;

301:   /* check if a user-defined split preconditioner has been set */
302:   STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL);
303:   if (nsplit) {
304:     STGetSplitPreconditionerTerm(eps->st,0,&Psplit[0]);
305:     if (eps->isgeneralized) STGetSplitPreconditionerTerm(eps->st,1,&Psplit[1]);
306:   }

308:   contour = ctx->contour;
309:   SlepcContourRedundantMat(contour,eps->isgeneralized?2:1,A,nsplit?Psplit:NULL);
310:   if (contour->pA) {
311:     BVGetColumn(ctx->V,0,&v0);
312:     SlepcContourScatterCreate(contour,v0);
313:     BVRestoreColumn(ctx->V,0,&v0);
314:     BVDestroy(&ctx->pV);
315:     BVCreate(PetscObjectComm((PetscObject)contour->xsub),&ctx->pV);
316:     BVSetSizesFromVec(ctx->pV,contour->xsub,eps->n);
317:     BVSetFromOptions(ctx->pV);
318:     BVResize(ctx->pV,ctx->L,PETSC_FALSE);
319:     PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
320:   }

322:   EPSCheckDefinite(eps);
323:   EPSCheckSinvertCondition(eps,ctx->usest," (with the usest flag set)");

325:   BVDestroy(&ctx->Y);
326:   if (contour->pA) {
327:     BVCreate(PetscObjectComm((PetscObject)contour->xsub),&ctx->Y);
328:     BVSetSizesFromVec(ctx->Y,contour->xsub,eps->n);
329:     BVSetFromOptions(ctx->Y);
330:     BVResize(ctx->Y,contour->npoints*ctx->L,PETSC_FALSE);
331:   } else BVDuplicateResize(eps->V,contour->npoints*ctx->L,&ctx->Y);
332:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);

334:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) DSSetType(eps->ds,DSGNHEP);
335:   else if (eps->isgeneralized) {
336:     if (eps->ishermitian && eps->ispositive) DSSetType(eps->ds,DSGHEP);
337:     else DSSetType(eps->ds,DSGNHEP);
338:   } else {
339:     if (eps->ishermitian) DSSetType(eps->ds,DSHEP);
340:     else DSSetType(eps->ds,DSNHEP);
341:   }
342:   DSAllocate(eps->ds,eps->ncv);

344: #if !defined(PETSC_USE_COMPLEX)
345:   EPSSetWorkVecs(eps,3);
346:   if (!eps->ishermitian) PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n");
347: #else
348:   EPSSetWorkVecs(eps,2);
349: #endif
350:   PetscFunctionReturn(0);
351: }

353: PetscErrorCode EPSSetUpSort_CISS(EPS eps)
354: {
355:   SlepcSC        sc;

357:   /* fill sorting criterion context */
358:   eps->sc->comparison    = SlepcCompareSmallestReal;
359:   eps->sc->comparisonctx = NULL;
360:   eps->sc->map           = NULL;
361:   eps->sc->mapobj        = NULL;

363:   /* fill sorting criterion for DS */
364:   DSGetSlepcSC(eps->ds,&sc);
365:   sc->comparison    = SlepcCompareLargestMagnitude;
366:   sc->comparisonctx = NULL;
367:   sc->map           = NULL;
368:   sc->mapobj        = NULL;
369:   PetscFunctionReturn(0);
370: }

372: PetscErrorCode EPSSolve_CISS(EPS eps)
373: {
374:   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
375:   SlepcContourData contour = ctx->contour;
376:   Mat              A,B,X,M,pA,pB,T,J,Pa=NULL,Pb=NULL;
377:   BV               V;
378:   PetscInt         i,j,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,nlocal,*inside,nsplit;
379:   PetscScalar      *Mu,*H0,*H1=NULL,*rr,*temp;
380:   PetscReal        error,max_error,norm;
381:   PetscBool        *fl1;
382:   Vec              si,si1=NULL,w[3];
383:   PetscRandom      rand;
384: #if defined(PETSC_USE_COMPLEX)
385:   PetscBool        isellipse;
386:   PetscReal        est_eig,eta;
387: #else
388:   PetscReal        normi;
389: #endif

391:   w[0] = eps->work[0];
392: #if defined(PETSC_USE_COMPLEX)
393:   w[1] = NULL;
394: #else
395:   w[1] = eps->work[2];
396: #endif
397:   w[2] = eps->work[1];
398:   VecGetLocalSize(w[0],&nlocal);
399:   DSGetLeadingDimension(eps->ds,&ld);
400:   RGComputeQuadrature(eps->rg,ctx->quad==EPS_CISS_QUADRULE_CHEBYSHEV?RG_QUADRULE_CHEBYSHEV:RG_QUADRULE_TRAPEZOIDAL,ctx->N,ctx->omega,ctx->pp,ctx->weight);
401:   STGetNumMatrices(eps->st,&nmat);
402:   STGetMatrix(eps->st,0,&A);
403:   if (nmat>1) STGetMatrix(eps->st,1,&B);
404:   else B = NULL;
405:   J = (contour->pA && nmat>1)? contour->pA[1]: B;
406:   V = contour->pA? ctx->pV: ctx->V;
407:   if (!ctx->usest) {
408:     T = contour->pA? contour->pA[0]: A;
409:     STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL);
410:     if (nsplit) {
411:       if (contour->pA) {
412:         Pa = contour->pP[0];
413:         if (nsplit>1) Pb = contour->pP[1];
414:       } else {
415:         STGetSplitPreconditionerTerm(eps->st,0,&Pa);
416:         if (nsplit>1) STGetSplitPreconditionerTerm(eps->st,1,&Pb);
417:       }
418:     }
419:     EPSCISSSetUp(eps,T,J,Pa,Pb);
420:   }
421:   BVSetActiveColumns(ctx->V,0,ctx->L);
422:   BVSetRandomSign(ctx->V);
423:   BVGetRandomContext(ctx->V,&rand);

425:   if (contour->pA) BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup);
426:   EPSCISSSolve(eps,J,V,0,ctx->L);
427: #if defined(PETSC_USE_COMPLEX)
428:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
429:   if (isellipse) {
430:     BVTraceQuadrature(ctx->Y,ctx->V,ctx->L,ctx->L,ctx->weight,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj,&est_eig);
431:     PetscInfo(eps,"Estimated eigenvalue count: %f\n",(double)est_eig);
432:     eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
433:     L_add = PetscMax(0,(PetscInt)PetscCeilReal((est_eig*eta)/ctx->M)-ctx->L);
434:     if (L_add>ctx->L_max-ctx->L) {
435:       PetscInfo(eps,"Number of eigenvalues inside the contour path may be too large\n");
436:       L_add = ctx->L_max-ctx->L;
437:     }
438:   }
439: #endif
440:   if (L_add>0) {
441:     PetscInfo(eps,"Changing L %" PetscInt_FMT " -> %" PetscInt_FMT " by Estimate #Eig\n",ctx->L,ctx->L+L_add);
442:     BVCISSResizeBases(ctx->S,contour->pA?ctx->pV:ctx->V,ctx->Y,ctx->L,ctx->L+L_add,ctx->M,contour->npoints);
443:     BVSetActiveColumns(ctx->V,ctx->L,ctx->L+L_add);
444:     BVSetRandomSign(ctx->V);
445:     if (contour->pA) BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup);
446:     ctx->L += L_add;
447:     EPSCISSSolve(eps,J,V,ctx->L-L_add,ctx->L);
448:   }
449:   PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
450:   for (i=0;i<ctx->refine_blocksize;i++) {
451:     BVDotQuadrature(ctx->Y,(contour->pA)?ctx->pV:ctx->V,Mu,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->subcomm,contour->npoints,ctx->useconj);
452:     CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0);
453:     PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0);
454:     SlepcCISS_BH_SVD(H0,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
455:     PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0);
456:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
457:     L_add = L_base;
458:     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
459:     PetscInfo(eps,"Changing L %" PetscInt_FMT " -> %" PetscInt_FMT " by SVD(H0)\n",ctx->L,ctx->L+L_add);
460:     BVCISSResizeBases(ctx->S,contour->pA?ctx->pV:ctx->V,ctx->Y,ctx->L,ctx->L+L_add,ctx->M,contour->npoints);
461:     BVSetActiveColumns(ctx->V,ctx->L,ctx->L+L_add);
462:     BVSetRandomSign(ctx->V);
463:     if (contour->pA) BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup);
464:     ctx->L += L_add;
465:     EPSCISSSolve(eps,J,V,ctx->L-L_add,ctx->L);
466:     if (L_add) {
467:       PetscFree2(Mu,H0);
468:       PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
469:     }
470:   }
471:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscMalloc1(ctx->L*ctx->M*ctx->L*ctx->M,&H1);

473:   while (eps->reason == EPS_CONVERGED_ITERATING) {
474:     eps->its++;
475:     for (inner=0;inner<=ctx->refine_inner;inner++) {
476:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
477:         BVDotQuadrature(ctx->Y,(contour->pA)?ctx->pV:ctx->V,Mu,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->subcomm,contour->npoints,ctx->useconj);
478:         CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0);
479:         PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0);
480:         SlepcCISS_BH_SVD(H0,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
481:         PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0);
482:         break;
483:       } else {
484:         BVSumQuadrature(ctx->S,ctx->Y,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj);
485:         BVSetActiveColumns(ctx->S,0,ctx->L);
486:         BVSetActiveColumns(ctx->V,0,ctx->L);
487:         BVCopy(ctx->S,ctx->V);
488:         BVSVDAndRank(ctx->S,ctx->M,ctx->L,ctx->delta,BV_SVD_METHOD_REFINE,H0,ctx->sigma,&nv);
489:         if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
490:           if (contour->pA) BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup);
491:           EPSCISSSolve(eps,J,V,0,ctx->L);
492:         } else break;
493:       }
494:     }
495:     eps->nconv = 0;
496:     if (nv == 0) eps->reason = EPS_CONVERGED_TOL;
497:     else {
498:       DSSetDimensions(eps->ds,nv,0,0);
499:       DSSetState(eps->ds,DS_STATE_RAW);

501:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
502:         CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0);
503:         CISS_BlockHankel(Mu,1,ctx->L,ctx->M,H1);
504:         DSGetArray(eps->ds,DS_MAT_A,&temp);
505:         for (j=0;j<nv;j++) {
506:           for (i=0;i<nv;i++) {
507:             temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
508:           }
509:         }
510:         DSRestoreArray(eps->ds,DS_MAT_A,&temp);
511:         DSGetArray(eps->ds,DS_MAT_B,&temp);
512:         for (j=0;j<nv;j++) {
513:           for (i=0;i<nv;i++) {
514:             temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
515:           }
516:         }
517:         DSRestoreArray(eps->ds,DS_MAT_B,&temp);
518:       } else {
519:         BVSetActiveColumns(ctx->S,0,nv);
520:         DSGetMat(eps->ds,DS_MAT_A,&pA);
521:         MatZeroEntries(pA);
522:         BVMatProject(ctx->S,A,ctx->S,pA);
523:         DSRestoreMat(eps->ds,DS_MAT_A,&pA);
524:         if (B) {
525:           DSGetMat(eps->ds,DS_MAT_B,&pB);
526:           MatZeroEntries(pB);
527:           BVMatProject(ctx->S,B,ctx->S,pB);
528:           DSRestoreMat(eps->ds,DS_MAT_B,&pB);
529:         }
530:       }

532:       DSSolve(eps->ds,eps->eigr,eps->eigi);
533:       DSSynchronize(eps->ds,eps->eigr,eps->eigi);

535:       PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
536:       rescale_eig(eps,nv);
537:       DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
538:       DSGetMat(eps->ds,DS_MAT_X,&X);
539:       SlepcCISS_isGhost(X,nv,ctx->sigma,ctx->spurious_threshold,fl1);
540:       MatDestroy(&X);
541:       RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
542:       for (i=0;i<nv;i++) {
543:         if (fl1[i] && inside[i]>=0) {
544:           rr[i] = 1.0;
545:           eps->nconv++;
546:         } else rr[i] = 0.0;
547:       }
548:       DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
549:       DSSynchronize(eps->ds,eps->eigr,eps->eigi);
550:       rescale_eig(eps,nv);
551:       PetscFree3(fl1,inside,rr);
552:       BVSetActiveColumns(eps->V,0,nv);
553:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
554:         BVSumQuadrature(ctx->S,ctx->Y,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj);
555:         BVSetActiveColumns(ctx->S,0,ctx->L);
556:         BVCopy(ctx->S,ctx->V);
557:         BVSetActiveColumns(ctx->S,0,nv);
558:       }
559:       BVCopy(ctx->S,eps->V);

561:       DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
562:       DSGetMat(eps->ds,DS_MAT_X,&X);
563:       BVMultInPlace(ctx->S,X,0,eps->nconv);
564:       if (eps->ishermitian) BVMultInPlace(eps->V,X,0,eps->nconv);
565:       MatDestroy(&X);
566:       max_error = 0.0;
567:       for (i=0;i<eps->nconv;i++) {
568:         BVGetColumn(ctx->S,i,&si);
569: #if !defined(PETSC_USE_COMPLEX)
570:         if (eps->eigi[i]!=0.0) BVGetColumn(ctx->S,i+1,&si1);
571: #endif
572:         EPSComputeResidualNorm_Private(eps,PETSC_FALSE,eps->eigr[i],eps->eigi[i],si,si1,w,&error);
573:         if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {  /* vector is not normalized */
574:           VecNorm(si,NORM_2,&norm);
575: #if !defined(PETSC_USE_COMPLEX)
576:           if (eps->eigi[i]!=0.0) {
577:             VecNorm(si1,NORM_2,&normi);
578:             norm = SlepcAbsEigenvalue(norm,normi);
579:           }
580: #endif
581:           error /= norm;
582:         }
583:         (*eps->converged)(eps,eps->eigr[i],eps->eigi[i],error,&error,eps->convergedctx);
584:         BVRestoreColumn(ctx->S,i,&si);
585: #if !defined(PETSC_USE_COMPLEX)
586:         if (eps->eigi[i]!=0.0) {
587:           BVRestoreColumn(ctx->S,i+1,&si1);
588:           i++;
589:         }
590: #endif
591:         max_error = PetscMax(max_error,error);
592:       }

594:       if (max_error <= eps->tol) eps->reason = EPS_CONVERGED_TOL;
595:       else if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
596:       else {
597:         if (eps->nconv > ctx->L) nv = eps->nconv;
598:         else if (ctx->L > nv) nv = ctx->L;
599:         nv = PetscMin(nv,ctx->L*ctx->M);
600:         MatCreateSeqDense(PETSC_COMM_SELF,nv,ctx->L,NULL,&M);
601:         MatSetRandom(M,rand);
602:         BVSetActiveColumns(ctx->S,0,nv);
603:         BVMultInPlace(ctx->S,M,0,ctx->L);
604:         MatDestroy(&M);
605:         BVSetActiveColumns(ctx->S,0,ctx->L);
606:         BVSetActiveColumns(ctx->V,0,ctx->L);
607:         BVCopy(ctx->S,ctx->V);
608:         if (contour->pA) BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup);
609:         EPSCISSSolve(eps,J,V,0,ctx->L);
610:       }
611:     }
612:   }
613:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscFree(H1);
614:   PetscFree2(Mu,H0);
615:   PetscFunctionReturn(0);
616: }

618: PetscErrorCode EPSComputeVectors_CISS(EPS eps)
619: {
620:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
621:   PetscInt       n;
622:   Mat            Z,B=NULL;

624:   if (eps->ishermitian) {
625:     if (eps->isgeneralized && !eps->ispositive) EPSComputeVectors_Indefinite(eps);
626:     else EPSComputeVectors_Hermitian(eps);
627:     if (eps->isgeneralized && eps->ispositive && ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
628:       /* normalize to have unit B-norm */
629:       STGetMatrix(eps->st,1,&B);
630:       BVSetMatrix(eps->V,B,PETSC_FALSE);
631:       BVNormalize(eps->V,NULL);
632:       BVSetMatrix(eps->V,NULL,PETSC_FALSE);
633:     }
634:     PetscFunctionReturn(0);
635:   }
636:   DSGetDimensions(eps->ds,&n,NULL,NULL,NULL);
637:   BVSetActiveColumns(eps->V,0,n);

639:   /* right eigenvectors */
640:   DSVectors(eps->ds,DS_MAT_X,NULL,NULL);

642:   /* V = V * Z */
643:   DSGetMat(eps->ds,DS_MAT_X,&Z);
644:   BVMultInPlace(eps->V,Z,0,n);
645:   MatDestroy(&Z);
646:   BVSetActiveColumns(eps->V,0,eps->nconv);

648:   /* normalize */
649:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) BVNormalize(eps->V,NULL);
650:   PetscFunctionReturn(0);
651: }

653: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
654: {
655:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
656:   PetscInt       oN,oL,oM,oLmax,onpart;
657:   PetscMPIInt    size;

659:   oN = ctx->N;
660:   if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
661:     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
662:   } else {
665:     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
666:   }
667:   oL = ctx->L;
668:   if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
669:     ctx->L = 16;
670:   } else {
672:     ctx->L = bs;
673:   }
674:   oM = ctx->M;
675:   if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
676:     ctx->M = ctx->N/4;
677:   } else {
680:     ctx->M = ms;
681:   }
682:   onpart = ctx->npart;
683:   if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
684:     ctx->npart = 1;
685:   } else {
686:     MPI_Comm_size(PetscObjectComm((PetscObject)eps),&size);
688:     ctx->npart = npart;
689:   }
690:   oLmax = ctx->L_max;
691:   if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
692:     ctx->L_max = 64;
693:   } else {
695:     ctx->L_max = PetscMax(bsmax,ctx->L);
696:   }
697:   if (onpart != ctx->npart || oN != ctx->N || realmats != ctx->isreal) {
698:     SlepcContourDataDestroy(&ctx->contour);
699:     PetscInfo(eps,"Resetting the contour data structure due to a change of parameters\n");
700:     eps->state = EPS_STATE_INITIAL;
701:   }
702:   ctx->isreal = realmats;
703:   if (oL != ctx->L || oM != ctx->M || oLmax != ctx->L_max) eps->state = EPS_STATE_INITIAL;
704:   PetscFunctionReturn(0);
705: }

707: /*@
708:    EPSCISSSetSizes - Sets the values of various size parameters in the CISS solver.

710:    Logically Collective on eps

712:    Input Parameters:
713: +  eps   - the eigenproblem solver context
714: .  ip    - number of integration points
715: .  bs    - block size
716: .  ms    - moment size
717: .  npart - number of partitions when splitting the communicator
718: .  bsmax - max block size
719: -  realmats - A and B are real

721:    Options Database Keys:
722: +  -eps_ciss_integration_points - Sets the number of integration points
723: .  -eps_ciss_blocksize - Sets the block size
724: .  -eps_ciss_moments - Sets the moment size
725: .  -eps_ciss_partitions - Sets the number of partitions
726: .  -eps_ciss_maxblocksize - Sets the maximum block size
727: -  -eps_ciss_realmats - A and B are real

729:    Note:
730:    The default number of partitions is 1. This means the internal KSP object is shared
731:    among all processes of the EPS communicator. Otherwise, the communicator is split
732:    into npart communicators, so that npart KSP solves proceed simultaneously.

734:    Level: advanced

736: .seealso: EPSCISSGetSizes()
737: @*/
738: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
739: {
747:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,realmats));
748:   PetscFunctionReturn(0);
749: }

751: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
752: {
753:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

755:   if (ip) *ip = ctx->N;
756:   if (bs) *bs = ctx->L;
757:   if (ms) *ms = ctx->M;
758:   if (npart) *npart = ctx->npart;
759:   if (bsmax) *bsmax = ctx->L_max;
760:   if (realmats) *realmats = ctx->isreal;
761:   PetscFunctionReturn(0);
762: }

764: /*@
765:    EPSCISSGetSizes - Gets the values of various size parameters in the CISS solver.

767:    Not Collective

769:    Input Parameter:
770: .  eps - the eigenproblem solver context

772:    Output Parameters:
773: +  ip    - number of integration points
774: .  bs    - block size
775: .  ms    - moment size
776: .  npart - number of partitions when splitting the communicator
777: .  bsmax - max block size
778: -  realmats - A and B are real

780:    Level: advanced

782: .seealso: EPSCISSSetSizes()
783: @*/
784: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
785: {
787:   PetscUseMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,realmats));
788:   PetscFunctionReturn(0);
789: }

791: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
792: {
793:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

795:   if (delta == PETSC_DEFAULT) {
796:     ctx->delta = SLEPC_DEFAULT_TOL*1e-4;
797:   } else {
799:     ctx->delta = delta;
800:   }
801:   if (spur == PETSC_DEFAULT) {
802:     ctx->spurious_threshold = PetscSqrtReal(SLEPC_DEFAULT_TOL);
803:   } else {
805:     ctx->spurious_threshold = spur;
806:   }
807:   PetscFunctionReturn(0);
808: }

810: /*@
811:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
812:    the CISS solver.

814:    Logically Collective on eps

816:    Input Parameters:
817: +  eps   - the eigenproblem solver context
818: .  delta - threshold for numerical rank
819: -  spur  - spurious threshold (to discard spurious eigenpairs)

821:    Options Database Keys:
822: +  -eps_ciss_delta - Sets the delta
823: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

825:    Level: advanced

827: .seealso: EPSCISSGetThreshold()
828: @*/
829: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
830: {
834:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
835:   PetscFunctionReturn(0);
836: }

838: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
839: {
840:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

842:   if (delta) *delta = ctx->delta;
843:   if (spur)  *spur = ctx->spurious_threshold;
844:   PetscFunctionReturn(0);
845: }

847: /*@
848:    EPSCISSGetThreshold - Gets the values of various threshold parameters
849:    in the CISS solver.

851:    Not Collective

853:    Input Parameter:
854: .  eps - the eigenproblem solver context

856:    Output Parameters:
857: +  delta - threshold for numerical rank
858: -  spur  - spurious threshold (to discard spurious eigenpairs)

860:    Level: advanced

862: .seealso: EPSCISSSetThreshold()
863: @*/
864: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
865: {
867:   PetscUseMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
868:   PetscFunctionReturn(0);
869: }

871: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt blsize)
872: {
873:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

875:   if (inner == PETSC_DEFAULT) {
876:     ctx->refine_inner = 0;
877:   } else {
879:     ctx->refine_inner = inner;
880:   }
881:   if (blsize == PETSC_DEFAULT) {
882:     ctx->refine_blocksize = 0;
883:   } else {
885:     ctx->refine_blocksize = blsize;
886:   }
887:   PetscFunctionReturn(0);
888: }

890: /*@
891:    EPSCISSSetRefinement - Sets the values of various refinement parameters
892:    in the CISS solver.

894:    Logically Collective on eps

896:    Input Parameters:
897: +  eps    - the eigenproblem solver context
898: .  inner  - number of iterative refinement iterations (inner loop)
899: -  blsize - number of iterative refinement iterations (blocksize loop)

901:    Options Database Keys:
902: +  -eps_ciss_refine_inner - Sets number of inner iterations
903: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

905:    Level: advanced

907: .seealso: EPSCISSGetRefinement()
908: @*/
909: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt blsize)
910: {
914:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt),(eps,inner,blsize));
915:   PetscFunctionReturn(0);
916: }

918: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *blsize)
919: {
920:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

922:   if (inner)  *inner = ctx->refine_inner;
923:   if (blsize) *blsize = ctx->refine_blocksize;
924:   PetscFunctionReturn(0);
925: }

927: /*@
928:    EPSCISSGetRefinement - Gets the values of various refinement parameters
929:    in the CISS solver.

931:    Not Collective

933:    Input Parameter:
934: .  eps - the eigenproblem solver context

936:    Output Parameters:
937: +  inner  - number of iterative refinement iterations (inner loop)
938: -  blsize - number of iterative refinement iterations (blocksize loop)

940:    Level: advanced

942: .seealso: EPSCISSSetRefinement()
943: @*/
944: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *blsize)
945: {
947:   PetscUseMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*),(eps,inner,blsize));
948:   PetscFunctionReturn(0);
949: }

951: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
952: {
953:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

955:   ctx->usest     = usest;
956:   ctx->usest_set = PETSC_TRUE;
957:   eps->state     = EPS_STATE_INITIAL;
958:   PetscFunctionReturn(0);
959: }

961: /*@
962:    EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
963:    use the ST object for the linear solves.

965:    Logically Collective on eps

967:    Input Parameters:
968: +  eps    - the eigenproblem solver context
969: -  usest  - boolean flag to use the ST object or not

971:    Options Database Keys:
972: .  -eps_ciss_usest <bool> - whether the ST object will be used or not

974:    Level: advanced

976: .seealso: EPSCISSGetUseST()
977: @*/
978: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
979: {
982:   PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
983:   PetscFunctionReturn(0);
984: }

986: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
987: {
988:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

990:   *usest = ctx->usest;
991:   PetscFunctionReturn(0);
992: }

994: /*@
995:    EPSCISSGetUseST - Gets the flag for using the ST object
996:    in the CISS solver.

998:    Not Collective

1000:    Input Parameter:
1001: .  eps - the eigenproblem solver context

1003:    Output Parameters:
1004: .  usest - boolean flag indicating if the ST object is being used

1006:    Level: advanced

1008: .seealso: EPSCISSSetUseST()
1009: @*/
1010: PetscErrorCode EPSCISSGetUseST(EPS eps,PetscBool *usest)
1011: {
1014:   PetscUseMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
1015:   PetscFunctionReturn(0);
1016: }

1018: static PetscErrorCode EPSCISSSetQuadRule_CISS(EPS eps,EPSCISSQuadRule quad)
1019: {
1020:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1022:   if (ctx->quad != quad) {
1023:     ctx->quad  = quad;
1024:     eps->state = EPS_STATE_INITIAL;
1025:   }
1026:   PetscFunctionReturn(0);
1027: }

1029: /*@
1030:    EPSCISSSetQuadRule - Sets the quadrature rule used in the CISS solver.

1032:    Logically Collective on eps

1034:    Input Parameters:
1035: +  eps  - the eigenproblem solver context
1036: -  quad - the quadrature rule

1038:    Options Database Key:
1039: .  -eps_ciss_quadrule - Sets the quadrature rule (either 'trapezoidal' or
1040:                            'chebyshev')

1042:    Notes:
1043:    By default, the trapezoidal rule is used (EPS_CISS_QUADRULE_TRAPEZOIDAL).

1045:    If the 'chebyshev' option is specified (EPS_CISS_QUADRULE_CHEBYSHEV), then
1046:    Chebyshev points are used as quadrature points.

1048:    Level: advanced

1050: .seealso: EPSCISSGetQuadRule(), EPSCISSQuadRule
1051: @*/
1052: PetscErrorCode EPSCISSSetQuadRule(EPS eps,EPSCISSQuadRule quad)
1053: {
1056:   PetscTryMethod(eps,"EPSCISSSetQuadRule_C",(EPS,EPSCISSQuadRule),(eps,quad));
1057:   PetscFunctionReturn(0);
1058: }

1060: static PetscErrorCode EPSCISSGetQuadRule_CISS(EPS eps,EPSCISSQuadRule *quad)
1061: {
1062:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1064:   *quad = ctx->quad;
1065:   PetscFunctionReturn(0);
1066: }

1068: /*@
1069:    EPSCISSGetQuadRule - Gets the quadrature rule used in the CISS solver.

1071:    Not Collective

1073:    Input Parameter:
1074: .  eps - the eigenproblem solver context

1076:    Output Parameters:
1077: .  quad - quadrature rule

1079:    Level: advanced

1081: .seealso: EPSCISSSetQuadRule() EPSCISSQuadRule
1082: @*/
1083: PetscErrorCode EPSCISSGetQuadRule(EPS eps,EPSCISSQuadRule *quad)
1084: {
1087:   PetscUseMethod(eps,"EPSCISSGetQuadRule_C",(EPS,EPSCISSQuadRule*),(eps,quad));
1088:   PetscFunctionReturn(0);
1089: }

1091: static PetscErrorCode EPSCISSSetExtraction_CISS(EPS eps,EPSCISSExtraction extraction)
1092: {
1093:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1095:   if (ctx->extraction != extraction) {
1096:     ctx->extraction = extraction;
1097:     eps->state      = EPS_STATE_INITIAL;
1098:   }
1099:   PetscFunctionReturn(0);
1100: }

1102: /*@
1103:    EPSCISSSetExtraction - Sets the extraction technique used in the CISS solver.

1105:    Logically Collective on eps

1107:    Input Parameters:
1108: +  eps        - the eigenproblem solver context
1109: -  extraction - the extraction technique

1111:    Options Database Key:
1112: .  -eps_ciss_extraction - Sets the extraction technique (either 'ritz' or
1113:                            'hankel')

1115:    Notes:
1116:    By default, the Rayleigh-Ritz extraction is used (EPS_CISS_EXTRACTION_RITZ).

1118:    If the 'hankel' option is specified (EPS_CISS_EXTRACTION_HANKEL), then
1119:    the Block Hankel method is used for extracting eigenpairs.

1121:    Level: advanced

1123: .seealso: EPSCISSGetExtraction(), EPSCISSExtraction
1124: @*/
1125: PetscErrorCode EPSCISSSetExtraction(EPS eps,EPSCISSExtraction extraction)
1126: {
1129:   PetscTryMethod(eps,"EPSCISSSetExtraction_C",(EPS,EPSCISSExtraction),(eps,extraction));
1130:   PetscFunctionReturn(0);
1131: }

1133: static PetscErrorCode EPSCISSGetExtraction_CISS(EPS eps,EPSCISSExtraction *extraction)
1134: {
1135:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1137:   *extraction = ctx->extraction;
1138:   PetscFunctionReturn(0);
1139: }

1141: /*@
1142:    EPSCISSGetExtraction - Gets the extraction technique used in the CISS solver.

1144:    Not Collective

1146:    Input Parameter:
1147: .  eps - the eigenproblem solver context

1149:    Output Parameters:
1150: .  extraction - extraction technique

1152:    Level: advanced

1154: .seealso: EPSCISSSetExtraction() EPSCISSExtraction
1155: @*/
1156: PetscErrorCode EPSCISSGetExtraction(EPS eps,EPSCISSExtraction *extraction)
1157: {
1160:   PetscUseMethod(eps,"EPSCISSGetExtraction_C",(EPS,EPSCISSExtraction*),(eps,extraction));
1161:   PetscFunctionReturn(0);
1162: }

1164: static PetscErrorCode EPSCISSGetKSPs_CISS(EPS eps,PetscInt *nsolve,KSP **ksp)
1165: {
1166:   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
1167:   SlepcContourData contour;
1168:   PetscInt         i,nsplit;
1169:   PC               pc;
1170:   MPI_Comm         child;

1172:   if (!ctx->contour) {  /* initialize contour data structure first */
1173:     RGCanUseConjugates(eps->rg,ctx->isreal,&ctx->useconj);
1174:     SlepcContourDataCreate(ctx->useconj?ctx->N/2:ctx->N,ctx->npart,(PetscObject)eps,&ctx->contour);
1175:   }
1176:   contour = ctx->contour;
1177:   if (!contour->ksp) {
1178:     PetscMalloc1(contour->npoints,&contour->ksp);
1179:     EPSGetST(eps,&eps->st);
1180:     STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL);
1181:     PetscSubcommGetChild(contour->subcomm,&child);
1182:     for (i=0;i<contour->npoints;i++) {
1183:       KSPCreate(child,&contour->ksp[i]);
1184:       PetscObjectIncrementTabLevel((PetscObject)contour->ksp[i],(PetscObject)eps,1);
1185:       KSPSetOptionsPrefix(contour->ksp[i],((PetscObject)eps)->prefix);
1186:       KSPAppendOptionsPrefix(contour->ksp[i],"eps_ciss_");
1187:       PetscLogObjectParent((PetscObject)eps,(PetscObject)contour->ksp[i]);
1188:       PetscObjectSetOptions((PetscObject)contour->ksp[i],((PetscObject)eps)->options);
1189:       KSPSetErrorIfNotConverged(contour->ksp[i],PETSC_TRUE);
1190:       KSPSetTolerances(contour->ksp[i],SlepcDefaultTol(eps->tol),PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
1191:       KSPGetPC(contour->ksp[i],&pc);
1192:       if (nsplit) {
1193:         KSPSetType(contour->ksp[i],KSPBCGS);
1194:         PCSetType(pc,PCBJACOBI);
1195:       } else {
1196:         KSPSetType(contour->ksp[i],KSPPREONLY);
1197:         PCSetType(pc,PCLU);
1198:       }
1199:     }
1200:   }
1201:   if (nsolve) *nsolve = contour->npoints;
1202:   if (ksp)    *ksp    = contour->ksp;
1203:   PetscFunctionReturn(0);
1204: }

1206: /*@C
1207:    EPSCISSGetKSPs - Retrieve the array of linear solver objects associated with
1208:    the CISS solver.

1210:    Not Collective

1212:    Input Parameter:
1213: .  eps - the eigenproblem solver solver

1215:    Output Parameters:
1216: +  nsolve - number of solver objects
1217: -  ksp - array of linear solver object

1219:    Notes:
1220:    The number of KSP solvers is equal to the number of integration points divided by
1221:    the number of partitions. This value is halved in the case of real matrices with
1222:    a region centered at the real axis.

1224:    Level: advanced

1226: .seealso: EPSCISSSetSizes()
1227: @*/
1228: PetscErrorCode EPSCISSGetKSPs(EPS eps,PetscInt *nsolve,KSP **ksp)
1229: {
1231:   PetscUseMethod(eps,"EPSCISSGetKSPs_C",(EPS,PetscInt*,KSP**),(eps,nsolve,ksp));
1232:   PetscFunctionReturn(0);
1233: }

1235: PetscErrorCode EPSReset_CISS(EPS eps)
1236: {
1237:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1239:   BVDestroy(&ctx->S);
1240:   BVDestroy(&ctx->V);
1241:   BVDestroy(&ctx->Y);
1242:   if (!ctx->usest) SlepcContourDataReset(ctx->contour);
1243:   BVDestroy(&ctx->pV);
1244:   PetscFunctionReturn(0);
1245: }

1247: PetscErrorCode EPSSetFromOptions_CISS(PetscOptionItems *PetscOptionsObject,EPS eps)
1248: {
1249:   PetscReal         r3,r4;
1250:   PetscInt          i,i1,i2,i3,i4,i5,i6,i7;
1251:   PetscBool         b1,b2,flg,flg2,flg3,flg4,flg5,flg6;
1252:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
1253:   EPSCISSQuadRule   quad;
1254:   EPSCISSExtraction extraction;

1256:   PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");

1258:     EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
1259:     PetscOptionsInt("-eps_ciss_integration_points","Number of integration points","EPSCISSSetSizes",i1,&i1,&flg);
1260:     PetscOptionsInt("-eps_ciss_blocksize","Block size","EPSCISSSetSizes",i2,&i2,&flg2);
1261:     PetscOptionsInt("-eps_ciss_moments","Moment size","EPSCISSSetSizes",i3,&i3,&flg3);
1262:     PetscOptionsInt("-eps_ciss_partitions","Number of partitions","EPSCISSSetSizes",i4,&i4,&flg4);
1263:     PetscOptionsInt("-eps_ciss_maxblocksize","Maximum block size","EPSCISSSetSizes",i5,&i5,&flg5);
1264:     PetscOptionsBool("-eps_ciss_realmats","True if A and B are real","EPSCISSSetSizes",b1,&b1,&flg6);
1265:     if (flg || flg2 || flg3 || flg4 || flg5 || flg6) EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

1267:     EPSCISSGetThreshold(eps,&r3,&r4);
1268:     PetscOptionsReal("-eps_ciss_delta","Threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,&flg);
1269:     PetscOptionsReal("-eps_ciss_spurious_threshold","Threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,&flg2);
1270:     if (flg || flg2) EPSCISSSetThreshold(eps,r3,r4);

1272:     EPSCISSGetRefinement(eps,&i6,&i7);
1273:     PetscOptionsInt("-eps_ciss_refine_inner","Number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,&flg);
1274:     PetscOptionsInt("-eps_ciss_refine_blocksize","Number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,&flg2);
1275:     if (flg || flg2) EPSCISSSetRefinement(eps,i6,i7);

1277:     EPSCISSGetUseST(eps,&b2);
1278:     PetscOptionsBool("-eps_ciss_usest","Use ST for linear solves","EPSCISSSetUseST",b2,&b2,&flg);
1279:     if (flg) EPSCISSSetUseST(eps,b2);

1281:     PetscOptionsEnum("-eps_ciss_quadrule","Quadrature rule","EPSCISSSetQuadRule",EPSCISSQuadRules,(PetscEnum)ctx->quad,(PetscEnum*)&quad,&flg);
1282:     if (flg) EPSCISSSetQuadRule(eps,quad);

1284:     PetscOptionsEnum("-eps_ciss_extraction","Extraction technique","EPSCISSSetExtraction",EPSCISSExtractions,(PetscEnum)ctx->extraction,(PetscEnum*)&extraction,&flg);
1285:     if (flg) EPSCISSSetExtraction(eps,extraction);

1287:   PetscOptionsTail();

1289:   if (!eps->rg) EPSGetRG(eps,&eps->rg);
1290:   RGSetFromOptions(eps->rg); /* this is necessary here to set useconj */
1291:   if (!ctx->contour || !ctx->contour->ksp) EPSCISSGetKSPs(eps,NULL,NULL);
1292:   for (i=0;i<ctx->contour->npoints;i++) KSPSetFromOptions(ctx->contour->ksp[i]);
1293:   PetscSubcommSetFromOptions(ctx->contour->subcomm);
1294:   PetscFunctionReturn(0);
1295: }

1297: PetscErrorCode EPSDestroy_CISS(EPS eps)
1298: {
1299:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1301:   SlepcContourDataDestroy(&ctx->contour);
1302:   PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
1303:   PetscFree(eps->data);
1304:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
1305:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
1306:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
1307:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
1308:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
1309:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
1310:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
1311:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
1312:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",NULL);
1313:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",NULL);
1314:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",NULL);
1315:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",NULL);
1316:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",NULL);
1317:   PetscFunctionReturn(0);
1318: }

1320: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
1321: {
1322:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
1323:   PetscBool      isascii;
1324:   PetscViewer    sviewer;

1326:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1327:   if (isascii) {
1328:     PetscViewerASCIIPrintf(viewer,"  sizes { integration points: %" PetscInt_FMT ", block size: %" PetscInt_FMT ", moment size: %" PetscInt_FMT ", partitions: %" PetscInt_FMT ", maximum block size: %" PetscInt_FMT " }\n",ctx->N,ctx->L,ctx->M,ctx->npart,ctx->L_max);
1329:     if (ctx->isreal) PetscViewerASCIIPrintf(viewer,"  exploiting symmetry of integration points\n");
1330:     PetscViewerASCIIPrintf(viewer,"  threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
1331:     PetscViewerASCIIPrintf(viewer,"  iterative refinement { inner: %" PetscInt_FMT ", blocksize: %" PetscInt_FMT " }\n",ctx->refine_inner, ctx->refine_blocksize);
1332:     PetscViewerASCIIPrintf(viewer,"  extraction: %s\n",EPSCISSExtractions[ctx->extraction]);
1333:     PetscViewerASCIIPrintf(viewer,"  quadrature rule: %s\n",EPSCISSQuadRules[ctx->quad]);
1334:     if (ctx->usest) PetscViewerASCIIPrintf(viewer,"  using ST for linear solves\n");
1335:     else {
1336:       if (!ctx->contour || !ctx->contour->ksp) EPSCISSGetKSPs(eps,NULL,NULL);
1337:       PetscViewerASCIIPushTab(viewer);
1338:       if (ctx->npart>1 && ctx->contour->subcomm) {
1339:         PetscViewerGetSubViewer(viewer,ctx->contour->subcomm->child,&sviewer);
1340:         if (!ctx->contour->subcomm->color) KSPView(ctx->contour->ksp[0],sviewer);
1341:         PetscViewerFlush(sviewer);
1342:         PetscViewerRestoreSubViewer(viewer,ctx->contour->subcomm->child,&sviewer);
1343:         PetscViewerFlush(viewer);
1344:         /* extra call needed because of the two calls to PetscViewerASCIIPushSynchronized() in PetscViewerGetSubViewer() */
1345:         PetscViewerASCIIPopSynchronized(viewer);
1346:       } else KSPView(ctx->contour->ksp[0],viewer);
1347:       PetscViewerASCIIPopTab(viewer);
1348:     }
1349:   }
1350:   PetscFunctionReturn(0);
1351: }

1353: PetscErrorCode EPSSetDefaultST_CISS(EPS eps)
1354: {
1355:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
1356:   PetscBool      usest = ctx->usest;
1357:   KSP            ksp;
1358:   PC             pc;

1360:   if (!((PetscObject)eps->st)->type_name) {
1361:     if (!ctx->usest_set) usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;
1362:     if (usest) STSetType(eps->st,STSINVERT);
1363:     else {
1364:       /* we are not going to use ST, so avoid factorizing the matrix */
1365:       STSetType(eps->st,STSHIFT);
1366:       if (eps->isgeneralized) {
1367:         STGetKSP(eps->st,&ksp);
1368:         KSPGetPC(ksp,&pc);
1369:         PCSetType(pc,PCNONE);
1370:       }
1371:     }
1372:   }
1373:   PetscFunctionReturn(0);
1374: }

1376: SLEPC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
1377: {
1378:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1380:   PetscNewLog(eps,&ctx);
1381:   eps->data = ctx;

1383:   eps->useds = PETSC_TRUE;
1384:   eps->categ = EPS_CATEGORY_CONTOUR;

1386:   eps->ops->solve          = EPSSolve_CISS;
1387:   eps->ops->setup          = EPSSetUp_CISS;
1388:   eps->ops->setupsort      = EPSSetUpSort_CISS;
1389:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
1390:   eps->ops->destroy        = EPSDestroy_CISS;
1391:   eps->ops->reset          = EPSReset_CISS;
1392:   eps->ops->view           = EPSView_CISS;
1393:   eps->ops->computevectors = EPSComputeVectors_CISS;
1394:   eps->ops->setdefaultst   = EPSSetDefaultST_CISS;

1396:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
1397:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
1398:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
1399:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
1400:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
1401:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
1402:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
1403:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
1404:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",EPSCISSSetQuadRule_CISS);
1405:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",EPSCISSGetQuadRule_CISS);
1406:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",EPSCISSSetExtraction_CISS);
1407:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",EPSCISSGetExtraction_CISS);
1408:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",EPSCISSGetKSPs_CISS);

1410:   /* set default values of parameters */
1411:   ctx->N                  = 32;
1412:   ctx->L                  = 16;
1413:   ctx->M                  = ctx->N/4;
1414:   ctx->delta              = SLEPC_DEFAULT_TOL*1e-4;
1415:   ctx->L_max              = 64;
1416:   ctx->spurious_threshold = PetscSqrtReal(SLEPC_DEFAULT_TOL);
1417:   ctx->usest              = PETSC_TRUE;
1418:   ctx->usest_set          = PETSC_FALSE;
1419:   ctx->isreal             = PETSC_FALSE;
1420:   ctx->refine_inner       = 0;
1421:   ctx->refine_blocksize   = 0;
1422:   ctx->npart              = 1;
1423:   ctx->quad               = (EPSCISSQuadRule)0;
1424:   ctx->extraction         = EPS_CISS_EXTRACTION_RITZ;
1425:   PetscFunctionReturn(0);
1426: }