Actual source code: ciss.c
slepc-3.7.4 2017-05-17
1: /*
3: SLEPc eigensolver: "ciss"
5: Method: Contour Integral Spectral Slicing
7: Algorithm:
9: Contour integral based on Sakurai-Sugiura method to construct a
10: subspace, with various eigenpair extractions (Rayleigh-Ritz,
11: explicit moment).
13: Based on code contributed by Y. Maeda, T. Sakurai.
15: References:
17: [1] T. Sakurai and H. Sugiura, "A projection method for generalized
18: eigenvalue problems", J. Comput. Appl. Math. 159:119-128, 2003.
20: [2] T. Sakurai and H. Tadano, "CIRR: a Rayleigh-Ritz type method with
21: contour integral for generalized eigenvalue problems", Hokkaido
22: Math. J. 36:745-757, 2007.
24: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
25: SLEPc - Scalable Library for Eigenvalue Problem Computations
26: Copyright (c) 2002-2016, Universitat Politecnica de Valencia, Spain
28: This file is part of SLEPc.
30: SLEPc is free software: you can redistribute it and/or modify it under the
31: terms of version 3 of the GNU Lesser General Public License as published by
32: the Free Software Foundation.
34: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
35: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
36: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
37: more details.
39: You should have received a copy of the GNU Lesser General Public License
40: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
41: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42: */
44: #include <slepc/private/epsimpl.h> /*I "slepceps.h" I*/
45: #include <slepcblaslapack.h>
47: typedef struct {
48: /* parameters */
49: PetscInt N; /* number of integration points (32) */
50: PetscInt L; /* block size (16) */
51: PetscInt M; /* moment degree (N/4 = 4) */
52: PetscReal delta; /* threshold of singular value (1e-12) */
53: PetscInt L_max; /* maximum number of columns of the source matrix V */
54: PetscReal spurious_threshold; /* discard spurious eigenpairs */
55: PetscBool isreal; /* A and B are real */
56: PetscInt refine_inner;
57: PetscInt refine_blocksize;
58: /* private data */
59: PetscReal *sigma; /* threshold for numerical rank */
60: PetscInt num_subcomm;
61: PetscInt subcomm_id;
62: PetscInt num_solve_point;
63: PetscScalar *weight;
64: PetscScalar *omega;
65: PetscScalar *pp;
66: BV V;
67: BV S;
68: BV pV;
69: BV Y;
70: Vec xsub;
71: Vec xdup;
72: KSP *ksp;
73: Mat *kspMat;
74: PetscBool useconj;
75: PetscReal est_eig;
76: VecScatter scatterin;
77: Mat pA,pB;
78: PetscSubcomm subcomm;
79: PetscBool usest;
80: PetscBool usest_set; /* whether the user set the usest flag or not */
81: EPSCISSQuadRule quad;
82: EPSCISSExtraction extraction;
83: } EPS_CISS;
87: static PetscErrorCode SetSolverComm(EPS eps)
88: {
90: EPS_CISS *ctx = (EPS_CISS*)eps->data;
91: PetscInt N = ctx->N;
94: if (ctx->useconj) N = N/2;
95: if (!ctx->subcomm) {
96: PetscSubcommCreate(PetscObjectComm((PetscObject)eps),&ctx->subcomm);
97: PetscSubcommSetNumber(ctx->subcomm,ctx->num_subcomm);
98: PetscSubcommSetType(ctx->subcomm,PETSC_SUBCOMM_INTERLACED);
99: PetscLogObjectMemory((PetscObject)eps,sizeof(PetscSubcomm));
100: PetscSubcommSetFromOptions(ctx->subcomm);
101: }
102: ctx->subcomm_id = ctx->subcomm->color;
103: ctx->num_solve_point = N / ctx->num_subcomm;
104: if ((N%ctx->num_subcomm) > ctx->subcomm_id) ctx->num_solve_point+=1;
105: return(0);
106: }
110: static PetscErrorCode CISSRedundantMat(EPS eps)
111: {
113: EPS_CISS *ctx = (EPS_CISS*)eps->data;
114: Mat A,B;
115: PetscInt nmat;
118: STGetNumMatrices(eps->st,&nmat);
119: if (ctx->subcomm->n != 1) {
120: STGetOperators(eps->st,0,&A);
121: MatCreateRedundantMatrix(A,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pA);
122: if (nmat>1) {
123: STGetOperators(eps->st,1,&B);
124: MatCreateRedundantMatrix(B,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pB);
125: } else ctx->pB = NULL;
126: } else {
127: ctx->pA = NULL;
128: ctx->pB = NULL;
129: }
130: return(0);
131: }
135: static PetscErrorCode CISSScatterVec(EPS eps)
136: {
138: EPS_CISS *ctx = (EPS_CISS*)eps->data;
139: IS is1,is2;
140: Vec v0;
141: PetscInt i,j,k,mstart,mend,mlocal;
142: PetscInt *idx1,*idx2,mloc_sub;
145: MatCreateVecs(ctx->pA,&ctx->xsub,NULL);
146: MatGetLocalSize(ctx->pA,&mloc_sub,NULL);
147: VecCreateMPI(PetscSubcommContiguousParent(ctx->subcomm),mloc_sub,PETSC_DECIDE,&ctx->xdup);
148: if (!ctx->scatterin) {
149: BVGetColumn(ctx->V,0,&v0);
150: VecGetOwnershipRange(v0,&mstart,&mend);
151: mlocal = mend - mstart;
152: PetscMalloc2(ctx->subcomm->n*mlocal,&idx1,ctx->subcomm->n*mlocal,&idx2);
153: j = 0;
154: for (k=0;k<ctx->subcomm->n;k++) {
155: for (i=mstart;i<mend;i++) {
156: idx1[j] = i;
157: idx2[j++] = i + eps->n*k;
158: }
159: }
160: ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx1,PETSC_COPY_VALUES,&is1);
161: ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx2,PETSC_COPY_VALUES,&is2);
162: VecScatterCreate(v0,is1,ctx->xdup,is2,&ctx->scatterin);
163: ISDestroy(&is1);
164: ISDestroy(&is2);
165: PetscFree2(idx1,idx2);
166: BVRestoreColumn(ctx->V,0,&v0);
167: }
168: return(0);
169: }
173: static PetscErrorCode SetPathParameter(EPS eps)
174: {
176: EPS_CISS *ctx = (EPS_CISS*)eps->data;
177: PetscInt i,j;
178: PetscScalar center=0.0,tmp,tmp2,*omegai;
179: PetscReal theta,radius=1.0,vscale,a,b,c,d,max_w=0.0,rgscale;
180: #if defined(PETSC_USE_COMPLEX)
181: PetscReal start_ang,end_ang;
182: #endif
183: PetscBool isring=PETSC_FALSE,isellipse=PETSC_FALSE,isinterval=PETSC_FALSE;
186: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
187: PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
188: PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
189: RGGetScale(eps->rg,&rgscale);
190: PetscMalloc1(ctx->N+1l,&omegai);
191: RGComputeContour(eps->rg,ctx->N,ctx->omega,omegai);
192: if (isellipse) {
193: RGEllipseGetParameters(eps->rg,¢er,&radius,&vscale);
194: for (i=0;i<ctx->N;i++) {
195: #if defined(PETSC_USE_COMPLEX)
196: theta = 2.0*PETSC_PI*(i+0.5)/ctx->N;
197: ctx->pp[i] = PetscCosReal(theta)+vscale*PetscSinReal(theta)*PETSC_i;
198: ctx->weight[i] = rgscale*radius*(vscale*PetscCosReal(theta)+PetscSinReal(theta)*PETSC_i)/(PetscReal)ctx->N;
199: #else
200: theta = (PETSC_PI/ctx->N)*(i+0.5);
201: ctx->pp[i] = PetscCosReal(theta);
202: ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
203: ctx->omega[i] = rgscale*(center + radius*ctx->pp[i]);
204: #endif
205: }
206: } else if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
207: for (i=0;i<ctx->N;i++) {
208: theta = (PETSC_PI/ctx->N)*(i+0.5);
209: ctx->pp[i] = PetscCosReal(theta);
210: ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
211: }
212: if (isinterval) {
213: RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
214: if ((c!=d || c!=0.0) && (a!=b || a!=0.0)) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Endpoints of the imaginary axis or the real axis must be both zero");
215: for (i=0;i<ctx->N;i++) {
216: if (c==d) ctx->omega[i] = ((b-a)*(ctx->pp[i]+1.0)/2.0+a)*rgscale;
217: if (a==b) {
218: #if defined(PETSC_USE_COMPLEX)
219: ctx->omega[i] = ((d-c)*(ctx->pp[i]+1.0)/2.0+c)*rgscale*PETSC_i;
220: #else
221: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
222: #endif
223: }
224: }
225: }
226: if (isring) { /* only supported in complex scalars */
227: #if defined(PETSC_USE_COMPLEX)
228: RGRingGetParameters(eps->rg,¢er,&radius,&vscale,&start_ang,&end_ang,NULL);
229: for (i=0;i<ctx->N;i++) {
230: theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(ctx->pp[i])+1.0))*PETSC_PI;
231: ctx->omega[i] = rgscale*(center + radius*(PetscCosReal(theta)+PETSC_i*vscale*PetscSinReal(theta)));
232: }
233: #endif
234: }
235: } else {
236: if (isinterval) {
237: RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
238: center = rgscale*((b+a)/2.0+(d+c)/2.0*PETSC_PI);
239: radius = PetscSqrtReal(PetscPowRealInt(rgscale*(b-a)/2.0,2)+PetscPowRealInt(rgscale*(d-c)/2.0,2));
240: } else if (isring) {
241: RGRingGetParameters(eps->rg,¢er,&radius,NULL,NULL,NULL,NULL);
242: center *= rgscale;
243: radius *= rgscale;
244: }
245: for (i=0;i<ctx->N;i++) {
246: ctx->pp[i] = (ctx->omega[i]-center)/radius;
247: tmp = 1; tmp2 = 1;
248: for (j=0;j<ctx->N;j++) {
249: tmp *= ctx->omega[j];
250: if (i != j) tmp2 *= ctx->omega[j]-ctx->omega[i];
251: }
252: ctx->weight[i] = tmp/tmp2;
253: max_w = PetscMax(PetscAbsScalar(ctx->weight[i]),max_w);
254: }
255: for (i=0;i<ctx->N;i++) ctx->weight[i] /= (PetscScalar)max_w;
256: }
257: PetscFree(omegai);
258: return(0);
259: }
263: static PetscErrorCode CISSVecSetRandom(BV V,PetscInt i0,PetscInt i1)
264: {
266: PetscInt i,j,nlocal;
267: PetscScalar *vdata;
268: Vec x;
271: BVGetSizes(V,&nlocal,NULL,NULL);
272: for (i=i0;i<i1;i++) {
273: BVSetRandomColumn(V,i);
274: BVGetColumn(V,i,&x);
275: VecGetArray(x,&vdata);
276: for (j=0;j<nlocal;j++) {
277: vdata[j] = PetscRealPart(vdata[j]);
278: if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
279: else vdata[j] = 1.0;
280: }
281: VecRestoreArray(x,&vdata);
282: BVRestoreColumn(V,i,&x);
283: }
284: return(0);
285: }
289: static PetscErrorCode VecScatterVecs(EPS eps,BV Vin,PetscInt n)
290: {
291: PetscErrorCode ierr;
292: EPS_CISS *ctx = (EPS_CISS*)eps->data;
293: PetscInt i;
294: Vec vi,pvi;
295: const PetscScalar *array;
298: for (i=0;i<n;i++) {
299: BVGetColumn(Vin,i,&vi);
300: VecScatterBegin(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
301: VecScatterEnd(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
302: BVRestoreColumn(Vin,i,&vi);
303: VecGetArrayRead(ctx->xdup,&array);
304: VecPlaceArray(ctx->xsub,array);
305: BVGetColumn(ctx->pV,i,&pvi);
306: VecCopy(ctx->xsub,pvi);
307: BVRestoreColumn(ctx->pV,i,&pvi);
308: VecResetArray(ctx->xsub);
309: VecRestoreArrayRead(ctx->xdup,&array);
310: }
311: return(0);
312: }
316: static PetscErrorCode SolveLinearSystem(EPS eps,Mat A,Mat B,BV V,PetscInt L_start,PetscInt L_end,PetscBool initksp)
317: {
319: EPS_CISS *ctx = (EPS_CISS*)eps->data;
320: PetscInt i,j,p_id;
321: Mat Fz;
322: PC pc;
323: Vec Bvj,vj,yj;
324: KSP ksp;
327: BVCreateVec(V,&Bvj);
328: if (ctx->usest) {
329: MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
330: }
331: for (i=0;i<ctx->num_solve_point;i++) {
332: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
333: if (!ctx->usest && initksp == PETSC_TRUE) {
334: MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&ctx->kspMat[i]);
335: MatCopy(A,ctx->kspMat[i],DIFFERENT_NONZERO_PATTERN);
336: if (B) {
337: MatAXPY(ctx->kspMat[i],-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
338: } else {
339: MatShift(ctx->kspMat[i],-ctx->omega[p_id]);
340: }
341: KSPSetOperators(ctx->ksp[i],ctx->kspMat[i],ctx->kspMat[i]);
342: KSPSetType(ctx->ksp[i],KSPPREONLY);
343: KSPGetPC(ctx->ksp[i],&pc);
344: PCSetType(pc,PCLU);
345: KSPSetFromOptions(ctx->ksp[i]);
346: } else if (ctx->usest) {
347: STSetShift(eps->st,ctx->omega[p_id]);
348: STGetKSP(eps->st,&ksp);
349: }
350: for (j=L_start;j<L_end;j++) {
351: BVGetColumn(V,j,&vj);
352: BVGetColumn(ctx->Y,i*ctx->L_max+j,&yj);
353: if (B) {
354: MatMult(B,vj,Bvj);
355: if (ctx->usest) {
356: KSPSolve(ksp,Bvj,yj);
357: } else {
358: KSPSolve(ctx->ksp[i],Bvj,yj);
359: }
360: } else {
361: if (ctx->usest) {
362: KSPSolve(ksp,vj,yj);
363: } else {
364: KSPSolve(ctx->ksp[i],vj,yj);
365: }
366: }
367: BVRestoreColumn(V,j,&vj);
368: BVRestoreColumn(ctx->Y,i*ctx->L_max+j,&yj);
369: }
370: if (ctx->usest && i<ctx->num_solve_point-1) { KSPReset(ksp); }
371: }
372: if (ctx->usest) { MatDestroy(&Fz); }
373: VecDestroy(&Bvj);
374: return(0);
375: }
377: #if defined(PETSC_USE_COMPLEX)
380: static PetscErrorCode EstimateNumberEigs(EPS eps,PetscInt *L_add)
381: {
383: EPS_CISS *ctx = (EPS_CISS*)eps->data;
384: PetscInt i,j,p_id;
385: PetscScalar tmp,m = 1,sum = 0.0;
386: PetscReal eta;
387: Vec v,vtemp,vj,yj;
390: BVGetColumn(ctx->Y,0,&yj);
391: VecDuplicate(yj,&v);
392: BVRestoreColumn(ctx->Y,0,&yj);
393: BVCreateVec(ctx->V,&vtemp);
394: for (j=0;j<ctx->L;j++) {
395: VecSet(v,0);
396: for (i=0;i<ctx->num_solve_point; i++) {
397: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
398: BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
399: BVMultVec(ctx->Y,ctx->weight[p_id],1,v,&m);
400: }
401: BVGetColumn(ctx->V,j,&vj);
402: if (ctx->pA) {
403: VecSet(vtemp,0);
404: VecScatterBegin(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
405: VecScatterEnd(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
406: VecDot(vj,vtemp,&tmp);
407: } else {
408: VecDot(vj,v,&tmp);
409: }
410: BVRestoreColumn(ctx->V,j,&vj);
411: if (ctx->useconj) sum += PetscRealPart(tmp)*2;
412: else sum += tmp;
413: }
414: ctx->est_eig = PetscAbsScalar(sum/(PetscReal)ctx->L);
415: eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
416: PetscInfo1(eps,"Estimation_#Eig %f\n",(double)ctx->est_eig);
417: *L_add = (PetscInt)PetscCeilReal((ctx->est_eig*eta)/ctx->M) - ctx->L;
418: if (*L_add < 0) *L_add = 0;
419: if (*L_add>ctx->L_max-ctx->L) {
420: PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
421: *L_add = ctx->L_max-ctx->L;
422: }
423: VecDestroy(&v);
424: VecDestroy(&vtemp);
425: return(0);
426: }
427: #endif
431: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
432: {
434: PetscMPIInt sub_size,len;
435: PetscInt i,j,k,s;
436: PetscScalar *m,*temp,*temp2,*ppk,alp;
437: EPS_CISS *ctx = (EPS_CISS*)eps->data;
438: Mat M;
441: MPI_Comm_size(PetscSubcommChild(ctx->subcomm),&sub_size);
442: PetscMalloc3(ctx->num_solve_point*ctx->L*(ctx->L+1),&temp,2*ctx->M*ctx->L*ctx->L,&temp2,ctx->num_solve_point,&ppk);
443: MatCreateSeqDense(PETSC_COMM_SELF,ctx->L,ctx->L_max*ctx->num_solve_point,NULL,&M);
444: for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
445: BVSetActiveColumns(ctx->Y,0,ctx->L_max*ctx->num_solve_point);
446: if (ctx->pA) {
447: BVSetActiveColumns(ctx->pV,0,ctx->L);
448: BVDot(ctx->Y,ctx->pV,M);
449: } else {
450: BVSetActiveColumns(ctx->V,0,ctx->L);
451: BVDot(ctx->Y,ctx->V,M);
452: }
453: MatDenseGetArray(M,&m);
454: for (i=0;i<ctx->num_solve_point;i++) {
455: for (j=0;j<ctx->L;j++) {
456: for (k=0;k<ctx->L;k++) {
457: temp[k+j*ctx->L+i*ctx->L*ctx->L]=m[k+j*ctx->L+i*ctx->L*ctx->L_max];
458: }
459: }
460: }
461: MatDenseRestoreArray(M,&m);
462: for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
463: for (k=0;k<2*ctx->M;k++) {
464: for (j=0;j<ctx->L;j++) {
465: for (i=0;i<ctx->num_solve_point;i++) {
466: alp = ppk[i]*ctx->weight[i*ctx->subcomm->n + ctx->subcomm_id];
467: for (s=0;s<ctx->L;s++) {
468: if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
469: else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
470: }
471: }
472: }
473: for (i=0;i<ctx->num_solve_point;i++)
474: ppk[i] *= ctx->pp[i*ctx->subcomm->n + ctx->subcomm_id];
475: }
476: for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] /= sub_size;
477: PetscMPIIntCast(2*ctx->M*ctx->L*ctx->L,&len);
478: MPI_Allreduce(temp2,Mu,len,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)eps));
479: PetscFree3(temp,temp2,ppk);
480: MatDestroy(&M);
481: return(0);
482: }
486: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,PetscScalar *H)
487: {
488: EPS_CISS *ctx = (EPS_CISS*)eps->data;
489: PetscInt i,j,k,L=ctx->L,M=ctx->M;
492: for (k=0;k<L*M;k++)
493: for (j=0;j<M;j++)
494: for (i=0;i<L;i++)
495: H[j*L+i+k*L*M] = Mu[i+k*L+(j+s)*L*L];
496: return(0);
497: }
501: static PetscErrorCode SVD_H0(EPS eps,PetscScalar *S,PetscInt *K)
502: {
503: #if defined(PETSC_MISSING_LAPACK_GESVD)
505: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
506: #else
508: EPS_CISS *ctx = (EPS_CISS*)eps->data;
509: PetscInt i,ml=ctx->L*ctx->M;
510: PetscBLASInt m,n,lda,ldu,ldvt,lwork,info;
511: PetscScalar *work;
512: #if defined(PETSC_USE_COMPLEX)
513: PetscReal *rwork;
514: #endif
517: PetscMalloc1(5*ml,&work);
518: #if defined(PETSC_USE_COMPLEX)
519: PetscMalloc1(5*ml,&rwork);
520: #endif
521: PetscBLASIntCast(ml,&m);
522: n = m; lda = m; ldu = m; ldvt = m; lwork = 5*m;
523: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
524: #if defined(PETSC_USE_COMPLEX)
525: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
526: #else
527: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
528: #endif
529: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
530: PetscFPTrapPop();
531: (*K) = 0;
532: for (i=0;i<ml;i++) {
533: if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
534: }
535: PetscFree(work);
536: #if defined(PETSC_USE_COMPLEX)
537: PetscFree(rwork);
538: #endif
539: return(0);
540: #endif
541: }
545: static PetscErrorCode ConstructS(EPS eps)
546: {
548: EPS_CISS *ctx = (EPS_CISS*)eps->data;
549: PetscInt i,j,k,vec_local_size,p_id;
550: Vec v,sj,yj;
551: PetscScalar *ppk, *v_data, m = 1;
554: BVGetSizes(ctx->Y,&vec_local_size,NULL,NULL);
555: PetscMalloc1(ctx->num_solve_point,&ppk);
556: for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
557: BVGetColumn(ctx->Y,0,&yj);
558: VecDuplicate(yj,&v);
559: BVRestoreColumn(ctx->Y,0,&yj);
560: for (k=0;k<ctx->M;k++) {
561: for (j=0;j<ctx->L;j++) {
562: VecSet(v,0);
563: for (i=0;i<ctx->num_solve_point;i++) {
564: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
565: BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
566: BVMultVec(ctx->Y,ppk[i]*ctx->weight[p_id],1.0,v,&m);
567: }
568: if (ctx->useconj) {
569: VecGetArray(v,&v_data);
570: for (i=0;i<vec_local_size;i++) v_data[i] = PetscRealPart(v_data[i])*2;
571: VecRestoreArray(v,&v_data);
572: }
573: BVGetColumn(ctx->S,k*ctx->L+j,&sj);
574: if (ctx->pA) {
575: VecSet(sj,0);
576: VecScatterBegin(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
577: VecScatterEnd(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
578: } else {
579: VecCopy(v,sj);
580: }
581: BVRestoreColumn(ctx->S,k*ctx->L+j,&sj);
582: }
583: for (i=0;i<ctx->num_solve_point;i++) {
584: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
585: ppk[i] *= ctx->pp[p_id];
586: }
587: }
588: PetscFree(ppk);
589: VecDestroy(&v);
590: return(0);
591: }
595: static PetscErrorCode SVD_S(BV S,PetscInt ml,PetscReal delta,PetscReal *sigma,PetscInt *K)
596: {
597: #if defined(PETSC_MISSING_LAPACK_GESVD)
599: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
600: #else
602: PetscInt i,j,k,local_size;
603: PetscMPIInt len;
604: PetscScalar *work,*temp,*B,*tempB,*s_data,*Q1,*Q2,*temp2,alpha=1,beta=0;
605: PetscBLASInt l,m,n,lda,ldu,ldvt,lwork,info,ldb,ldc;
606: #if defined(PETSC_USE_COMPLEX)
607: PetscReal *rwork;
608: #endif
611: BVGetSizes(S,&local_size,NULL,NULL);
612: BVGetArray(S,&s_data);
613: PetscMalloc7(ml*ml,&temp,ml*ml,&temp2,local_size*ml,&Q1,local_size*ml,&Q2,ml*ml,&B,ml*ml,&tempB,5*ml,&work);
614: PetscMemzero(B,ml*ml*sizeof(PetscScalar));
615: #if defined(PETSC_USE_COMPLEX)
616: PetscMalloc1(5*ml,&rwork);
617: #endif
618: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
620: for (i=0;i<ml;i++) B[i*ml+i]=1;
622: for (k=0;k<2;k++) {
623: PetscBLASIntCast(local_size,&m);
624: PetscBLASIntCast(ml,&l);
625: n = l; lda = m; ldb = m; ldc = l;
626: if (k == 0) {
627: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,s_data,&lda,s_data,&ldb,&beta,temp,&ldc));
628: } else if ((k%2)==1) {
629: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q1,&lda,Q1,&ldb,&beta,temp,&ldc));
630: } else {
631: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q2,&lda,Q2,&ldb,&beta,temp,&ldc));
632: }
633: PetscMemzero(temp2,ml*ml*sizeof(PetscScalar));
634: PetscMPIIntCast(ml*ml,&len);
635: MPI_Allreduce(temp,temp2,len,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)S));
637: PetscBLASIntCast(ml,&m);
638: n = m; lda = m; lwork = 5*m, ldu = 1; ldvt = 1;
639: #if defined(PETSC_USE_COMPLEX)
640: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
641: #else
642: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
643: #endif
644: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
646: PetscBLASIntCast(local_size,&l);
647: PetscBLASIntCast(ml,&n);
648: m = n; lda = l; ldb = m; ldc = l;
649: if (k==0) {
650: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,s_data,&lda,temp2,&ldb,&beta,Q1,&ldc));
651: } else if ((k%2)==1) {
652: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q1,&lda,temp2,&ldb,&beta,Q2,&ldc));
653: } else {
654: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q2,&lda,temp2,&ldb,&beta,Q1,&ldc));
655: }
657: PetscBLASIntCast(ml,&l);
658: m = l; n = l; lda = l; ldb = m; ldc = l;
659: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,B,&lda,temp2,&ldb,&beta,tempB,&ldc));
660: for (i=0;i<ml;i++) {
661: sigma[i] = sqrt(sigma[i]);
662: for (j=0;j<local_size;j++) {
663: if ((k%2)==1) Q2[j+i*local_size]/=sigma[i];
664: else Q1[j+i*local_size]/=sigma[i];
665: }
666: for (j=0;j<ml;j++) {
667: B[j+i*ml]=tempB[j+i*ml]*sigma[i];
668: }
669: }
670: }
672: PetscBLASIntCast(ml,&m);
673: n = m; lda = m; ldu=1; ldvt=1;
674: #if defined(PETSC_USE_COMPLEX)
675: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
676: #else
677: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
678: #endif
679: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
681: PetscBLASIntCast(local_size,&l);
682: PetscBLASIntCast(ml,&n);
683: m = n; lda = l; ldb = m; ldc = l;
684: if ((k%2)==1) {
685: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q1,&lda,B,&ldb,&beta,s_data,&ldc));
686: } else {
687: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q2,&lda,B,&ldb,&beta,s_data,&ldc));
688: }
690: PetscFPTrapPop();
691: BVRestoreArray(S,&s_data);
693: (*K) = 0;
694: for (i=0;i<ml;i++) {
695: if (sigma[i]/PetscMax(sigma[0],1)>delta) (*K)++;
696: }
697: PetscFree7(temp,temp2,Q1,Q2,B,tempB,work);
698: #if defined(PETSC_USE_COMPLEX)
699: PetscFree(rwork);
700: #endif
701: return(0);
702: #endif
703: }
707: static PetscErrorCode isGhost(EPS eps,PetscInt ld,PetscInt nv,PetscBool *fl)
708: {
710: EPS_CISS *ctx = (EPS_CISS*)eps->data;
711: PetscInt i,j;
712: PetscScalar *pX;
713: PetscReal *tau,s1,s2,tau_max=0.0;
716: PetscMalloc1(nv,&tau);
717: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
718: DSGetArray(eps->ds,DS_MAT_X,&pX);
720: for (i=0;i<nv;i++) {
721: s1 = 0;
722: s2 = 0;
723: for (j=0;j<nv;j++) {
724: s1 += PetscAbsScalar(PetscPowScalarInt(pX[i*ld+j],2));
725: s2 += PetscPowRealInt(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
726: }
727: tau[i] = s1/s2;
728: tau_max = PetscMax(tau_max,tau[i]);
729: }
730: DSRestoreArray(eps->ds,DS_MAT_X,&pX);
731: for (i=0;i<nv;i++) {
732: tau[i] /= tau_max;
733: }
734: for (i=0;i<nv;i++) {
735: if (tau[i]>=ctx->spurious_threshold) fl[i] = PETSC_TRUE;
736: else fl[i] = PETSC_FALSE;
737: }
738: PetscFree(tau);
739: return(0);
740: }
744: static PetscErrorCode rescale_eig(EPS eps,PetscInt nv)
745: {
747: EPS_CISS *ctx = (EPS_CISS*)eps->data;
748: PetscInt i;
749: PetscScalar center;
750: PetscReal radius,a,b,c,d,rgscale;
751: #if defined(PETSC_USE_COMPLEX)
752: PetscReal start_ang,end_ang,vscale,theta;
753: #endif
754: PetscBool isring,isellipse,isinterval;
757: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
758: PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
759: PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
760: RGGetScale(eps->rg,&rgscale);
761: if (isinterval) {
762: RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
763: if (c==d) {
764: for (i=0;i<nv;i++) {
765: #if defined(PETSC_USE_COMPLEX)
766: eps->eigr[i] = PetscRealPart(eps->eigr[i]);
767: #else
768: eps->eigi[i] = 0;
769: #endif
770: }
771: }
772: }
773: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
774: if (isellipse) {
775: RGEllipseGetParameters(eps->rg,¢er,&radius,NULL);
776: for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
777: } else if (isinterval) {
778: RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
779: if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
780: for (i=0;i<nv;i++) {
781: if (c==d) eps->eigr[i] = ((b-a)*(eps->eigr[i]+1.0)/2.0+a)*rgscale;
782: if (a==b) {
783: #if defined(PETSC_USE_COMPLEX)
784: eps->eigr[i] = ((d-c)*(eps->eigr[i]+1.0)/2.0+c)*rgscale*PETSC_i;
785: #else
786: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
787: #endif
788: }
789: }
790: } else {
791: center = (b+a)/2.0+(d+c)/2.0*PETSC_PI;
792: radius = PetscSqrtReal(PetscPowRealInt((b-a)/2.0,2)+PetscPowRealInt((d-c)/2.0,2));
793: for (i=0;i<nv;i++) eps->eigr[i] = center + radius*eps->eigr[i];
794: }
795: } else if (isring) { /* only supported in complex scalars */
796: #if defined(PETSC_USE_COMPLEX)
797: RGRingGetParameters(eps->rg,¢er,&radius,&vscale,&start_ang,&end_ang,NULL);
798: if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
799: for (i=0;i<nv;i++) {
800: theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(eps->eigr[i])+1.0))*PETSC_PI;
801: eps->eigr[i] = rgscale*center + (rgscale*radius+PetscImaginaryPart(eps->eigr[i]))*(PetscCosReal(theta)+PETSC_i*vscale*PetscSinReal(theta));
802: }
803: } else {
804: for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
805: }
806: #endif
807: }
808: }
809: return(0);
810: }
814: PetscErrorCode EPSSetUp_CISS(EPS eps)
815: {
817: EPS_CISS *ctx = (EPS_CISS*)eps->data;
818: PetscInt i;
819: PetscBool issinvert,istrivial,isring,isellipse,isinterval,flg;
820: PetscScalar center;
821: PetscReal c,d;
822: Mat A;
825: if (!eps->ncv) eps->ncv = ctx->L_max*ctx->M;
826: else {
827: EPSSetDimensions_Default(eps,eps->nev,&eps->ncv,&eps->mpd);
828: ctx->L_max = eps->ncv/ctx->M;
829: if (ctx->L_max == 0) {
830: ctx->L_max = 1;
831: eps->ncv = ctx->L_max*ctx->M;
832: }
833: if (ctx->L > ctx->L_max) ctx->L = ctx->L_max;
834: }
835: if (!eps->max_it) eps->max_it = 1;
836: if (!eps->mpd) eps->mpd = eps->ncv;
837: if (!eps->which) eps->which = EPS_ALL;
838: if (!eps->extraction) { EPSSetExtraction(eps,EPS_RITZ); }
839: else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
840: if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");
841: if (eps->stopping!=EPSStoppingBasic) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This solver does not support user-defined stopping test");
842: /* check region */
843: RGIsTrivial(eps->rg,&istrivial);
844: if (istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS requires a nontrivial region, e.g. -rg_type ellipse ...");
845: RGGetComplement(eps->rg,&flg);
846: if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"A region with complement flag set is not allowed");
847: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
848: PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
849: PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
850: if (!isellipse && !isring && !isinterval) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for interval, elliptic or ring regions");
851: if (isring) {
852: #if !defined(PETSC_USE_COMPLEX)
853: SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Ring region only supported for complex scalars");
854: #endif
855: ctx->useconj = PETSC_FALSE;
856: }
857: if (isellipse) {
858: RGEllipseGetParameters(eps->rg,¢er,NULL,NULL);
859: #if defined(PETSC_USE_COMPLEX)
860: if (ctx->isreal && PetscImaginaryPart(center) == 0.0) ctx->useconj = PETSC_TRUE;
861: else ctx->useconj = PETSC_FALSE;
862: #else
863: ctx->useconj = PETSC_FALSE;
864: #endif
865: }
866: if (isinterval) {
867: RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
868: #if defined(PETSC_USE_COMPLEX)
869: if (ctx->isreal && c==d) ctx->useconj = PETSC_TRUE;
870: else ctx->useconj = PETSC_FALSE;
871: #else
872: if (c!=d || c!=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"In real scalars, endpoints of the imaginary axis must be both zero");
873: ctx->useconj = PETSC_FALSE;
874: #endif
875: if (!ctx->quad && c==d) ctx->quad = EPS_CISS_QUADRULE_CHEBYSHEV;
876: }
877: if (!ctx->quad) ctx->quad = EPS_CISS_QUADRULE_TRAPEZOIDAL;
878: /* create split comm */
879: SetSolverComm(eps);
881: EPSAllocateSolution(eps,0);
882: PetscMalloc4(ctx->N,&ctx->weight,ctx->N+1,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
883: PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));
885: /* allocate basis vectors */
886: BVDuplicateResize(eps->V,ctx->L_max*ctx->M,&ctx->S);
887: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
888: BVDuplicateResize(eps->V,ctx->L_max,&ctx->V);
889: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);
891: STGetOperators(eps->st,0,&A);
892: PetscObjectTypeCompare((PetscObject)A,MATSHELL,&flg);
893: if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell is not supported in this solver");
895: if (!ctx->usest_set) ctx->usest = (ctx->num_subcomm>1)? PETSC_FALSE: PETSC_TRUE;
896: if (ctx->usest && ctx->num_subcomm>1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"The usest flag is not supported when partitions > 1");
898: CISSRedundantMat(eps);
899: if (ctx->pA) {
900: CISSScatterVec(eps);
901: BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->pV);
902: BVSetSizesFromVec(ctx->pV,ctx->xsub,eps->n);
903: BVSetFromOptions(ctx->pV);
904: BVResize(ctx->pV,ctx->L_max,PETSC_FALSE);
905: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
906: }
908: if (ctx->usest) {
909: PetscObjectTypeCompare((PetscObject)eps->st,STSINVERT,&issinvert);
910: if (!issinvert) { STSetType(eps->st,STSINVERT); }
911: } else {
912: STSetType(eps->st,STSHIFT); /* we are not going to use ST, so avoid problems in case the user provided one */
913: PetscMalloc2(ctx->num_solve_point,&ctx->ksp,ctx->num_solve_point,&ctx->kspMat);
914: PetscLogObjectMemory((PetscObject)eps,ctx->num_solve_point*sizeof(KSP)+ctx->num_solve_point*sizeof(Mat));
915: for (i=0;i<ctx->num_solve_point;i++) {
916: KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
917: PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
918: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->ksp[i]);
919: KSPSetOptionsPrefix(ctx->ksp[i],((PetscObject)eps)->prefix);
920: KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
921: KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
922: }
923: }
925: if (ctx->pA) {
926: BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->Y);
927: BVSetSizesFromVec(ctx->Y,ctx->xsub,eps->n);
928: BVSetFromOptions(ctx->Y);
929: BVResize(ctx->Y,ctx->num_solve_point*ctx->L_max,PETSC_FALSE);
930: } else {
931: BVDuplicateResize(eps->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);
932: }
933: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);
935: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
936: DSSetType(eps->ds,DSGNHEP);
937: } else if (eps->isgeneralized) {
938: if (eps->ishermitian && eps->ispositive) {
939: DSSetType(eps->ds,DSGHEP);
940: } else {
941: DSSetType(eps->ds,DSGNHEP);
942: }
943: } else {
944: if (eps->ishermitian) {
945: DSSetType(eps->ds,DSHEP);
946: } else {
947: DSSetType(eps->ds,DSNHEP);
948: }
949: }
950: DSAllocate(eps->ds,eps->ncv);
951: EPSSetWorkVecs(eps,2);
953: /* In GHEP problems, deactivate purification to avoid losing
954: B-normalization of eigenvectors in EPSComputeVectors_Schur */
955: eps->purify = PETSC_FALSE;
957: #if !defined(PETSC_USE_COMPLEX)
958: if (!eps->ishermitian) { PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"); }
959: #endif
960: return(0);
961: }
965: PetscErrorCode EPSSolve_CISS(EPS eps)
966: {
968: EPS_CISS *ctx = (EPS_CISS*)eps->data;
969: Mat A,B,X,M,pA,pB;
970: PetscInt i,j,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,nlocal,*inside;
971: PetscScalar *Mu,*H0,*H1=NULL,*rr,*temp;
972: PetscReal error,max_error;
973: PetscBool *fl1;
974: Vec si,w[3];
975: SlepcSC sc;
976: PetscRandom rand;
977: #if defined(PETSC_USE_COMPLEX)
978: PetscBool isellipse;
979: #endif
982: w[0] = eps->work[0];
983: w[1] = NULL;
984: w[2] = eps->work[1];
985: /* override SC settings */
986: DSGetSlepcSC(eps->ds,&sc);
987: sc->comparison = SlepcCompareLargestMagnitude;
988: sc->comparisonctx = NULL;
989: sc->map = NULL;
990: sc->mapobj = NULL;
991: VecGetLocalSize(w[0],&nlocal);
992: DSGetLeadingDimension(eps->ds,&ld);
993: STGetNumMatrices(eps->st,&nmat);
994: STGetOperators(eps->st,0,&A);
995: if (nmat>1) { STGetOperators(eps->st,1,&B); }
996: else B = NULL;
997: SetPathParameter(eps);
998: CISSVecSetRandom(ctx->V,0,ctx->L);
999: BVGetRandomContext(ctx->V,&rand);
1001: if (ctx->pA) {
1002: VecScatterVecs(eps,ctx->V,ctx->L);
1003: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_TRUE);
1004: } else {
1005: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_TRUE);
1006: }
1007: #if defined(PETSC_USE_COMPLEX)
1008: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
1009: if (isellipse) {
1010: EstimateNumberEigs(eps,&L_add);
1011: } else {
1012: L_add = 0;
1013: }
1014: #else
1015: L_add = 0;
1016: #endif
1017: if (L_add>0) {
1018: PetscInfo2(eps,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
1019: CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
1020: if (ctx->pA) {
1021: VecScatterVecs(eps,ctx->V,ctx->L+L_add);
1022: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
1023: } else {
1024: SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
1025: }
1026: ctx->L += L_add;
1027: }
1028: PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
1029: for (i=0;i<ctx->refine_blocksize;i++) {
1030: CalcMu(eps,Mu);
1031: BlockHankel(eps,Mu,0,H0);
1032: SVD_H0(eps,H0,&nv);
1033: if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
1034: L_add = L_base;
1035: if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
1036: PetscInfo2(eps,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
1037: CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
1038: if (ctx->pA) {
1039: VecScatterVecs(eps,ctx->V,ctx->L+L_add);
1040: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
1041: } else {
1042: SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
1043: }
1044: ctx->L += L_add;
1045: }
1046: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1047: PetscMalloc1(ctx->L*ctx->M*ctx->L*ctx->M,&H1);
1048: }
1050: while (eps->reason == EPS_CONVERGED_ITERATING) {
1051: eps->its++;
1052: for (inner=0;inner<=ctx->refine_inner;inner++) {
1053: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1054: CalcMu(eps,Mu);
1055: BlockHankel(eps,Mu,0,H0);
1056: SVD_H0(eps,H0,&nv);
1057: break;
1058: } else {
1059: ConstructS(eps);
1060: BVSetActiveColumns(ctx->S,0,ctx->L);
1061: BVCopy(ctx->S,ctx->V);
1062: SVD_S(ctx->S,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
1063: if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
1064: if (ctx->pA) {
1065: VecScatterVecs(eps,ctx->V,ctx->L);
1066: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
1067: } else {
1068: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
1069: }
1070: } else break;
1071: }
1072: }
1073: eps->nconv = 0;
1074: if (nv == 0) eps->reason = EPS_CONVERGED_TOL;
1075: else {
1076: DSSetDimensions(eps->ds,nv,0,0,0);
1077: DSSetState(eps->ds,DS_STATE_RAW);
1079: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1080: BlockHankel(eps,Mu,0,H0);
1081: BlockHankel(eps,Mu,1,H1);
1082: DSGetArray(eps->ds,DS_MAT_A,&temp);
1083: for (j=0;j<nv;j++) {
1084: for (i=0;i<nv;i++) {
1085: temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
1086: }
1087: }
1088: DSRestoreArray(eps->ds,DS_MAT_A,&temp);
1089: DSGetArray(eps->ds,DS_MAT_B,&temp);
1090: for (j=0;j<nv;j++) {
1091: for (i=0;i<nv;i++) {
1092: temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
1093: }
1094: }
1095: DSRestoreArray(eps->ds,DS_MAT_B,&temp);
1096: } else {
1097: BVSetActiveColumns(ctx->S,0,nv);
1098: DSGetMat(eps->ds,DS_MAT_A,&pA);
1099: MatZeroEntries(pA);
1100: BVMatProject(ctx->S,A,ctx->S,pA);
1101: DSRestoreMat(eps->ds,DS_MAT_A,&pA);
1102: if (B) {
1103: DSGetMat(eps->ds,DS_MAT_B,&pB);
1104: MatZeroEntries(pB);
1105: BVMatProject(ctx->S,B,ctx->S,pB);
1106: DSRestoreMat(eps->ds,DS_MAT_B,&pB);
1107: }
1108: }
1110: DSSolve(eps->ds,eps->eigr,eps->eigi);
1111: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
1113: PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
1114: rescale_eig(eps,nv);
1115: isGhost(eps,ld,nv,fl1);
1116: RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
1117: for (i=0;i<nv;i++) {
1118: if (fl1[i] && inside[i]>=0) {
1119: rr[i] = 1.0;
1120: eps->nconv++;
1121: } else rr[i] = 0.0;
1122: }
1123: DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
1124: rescale_eig(eps,nv);
1125: PetscFree3(fl1,inside,rr);
1126: BVSetActiveColumns(eps->V,0,nv);
1127: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1128: ConstructS(eps);
1129: BVSetActiveColumns(ctx->S,0,ctx->L);
1130: BVCopy(ctx->S,ctx->V);
1131: BVSetActiveColumns(ctx->S,0,nv);
1132: }
1133: BVCopy(ctx->S,eps->V);
1135: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
1136: DSGetMat(eps->ds,DS_MAT_X,&X);
1137: BVMultInPlace(ctx->S,X,0,eps->nconv);
1138: if (eps->ishermitian) {
1139: BVMultInPlace(eps->V,X,0,eps->nconv);
1140: }
1141: MatDestroy(&X);
1142: max_error = 0.0;
1143: for (i=0;i<eps->nconv;i++) {
1144: BVGetColumn(ctx->S,i,&si);
1145: EPSComputeResidualNorm_Private(eps,eps->eigr[i],eps->eigi[i],si,NULL,w,&error);
1146: (*eps->converged)(eps,eps->eigr[i],eps->eigi[i],error,&error,eps->convergedctx);
1147: BVRestoreColumn(ctx->S,i,&si);
1148: max_error = PetscMax(max_error,error);
1149: }
1151: if (max_error <= eps->tol) eps->reason = EPS_CONVERGED_TOL;
1152: else if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
1153: else {
1154: if (eps->nconv > ctx->L) {
1155: MatCreateSeqDense(PETSC_COMM_SELF,eps->nconv,ctx->L,NULL,&M);
1156: MatDenseGetArray(M,&temp);
1157: for (i=0;i<ctx->L*eps->nconv;i++) {
1158: PetscRandomGetValue(rand,&temp[i]);
1159: temp[i] = PetscRealPart(temp[i]);
1160: }
1161: MatDenseRestoreArray(M,&temp);
1162: BVSetActiveColumns(ctx->S,0,eps->nconv);
1163: BVMultInPlace(ctx->S,M,0,ctx->L);
1164: MatDestroy(&M);
1165: BVSetActiveColumns(ctx->S,0,ctx->L);
1166: BVCopy(ctx->S,ctx->V);
1167: }
1168: if (ctx->pA) {
1169: VecScatterVecs(eps,ctx->V,ctx->L);
1170: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
1171: } else {
1172: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
1173: }
1174: }
1175: }
1176: }
1177: if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1178: PetscFree(H1);
1179: }
1180: PetscFree2(Mu,H0);
1181: return(0);
1182: }
1186: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
1187: {
1189: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1192: if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
1193: if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
1194: } else {
1195: if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
1196: if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
1197: if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
1198: }
1199: if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
1200: ctx->L = 16;
1201: } else {
1202: if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
1203: if (bs>ctx->L_max) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be less than or equal to the maximum number of block size");
1204: ctx->L = bs;
1205: }
1206: if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
1207: ctx->M = ctx->N/4;
1208: } else {
1209: if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
1210: if (ms>ctx->N) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be less than or equal to the number of integration points");
1211: ctx->M = ms;
1212: }
1213: if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
1214: ctx->num_subcomm = 1;
1215: } else {
1216: if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
1217: ctx->num_subcomm = npart;
1218: }
1219: if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
1220: ctx->L = 256;
1221: } else {
1222: if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
1223: if (bsmax<ctx->L) ctx->L_max = ctx->L;
1224: else ctx->L_max = bsmax;
1225: }
1226: ctx->isreal = realmats;
1227: EPSReset(eps); /* clean allocated arrays and force new setup */
1228: return(0);
1229: }
1233: /*@
1234: EPSCISSSetSizes - Sets the values of various size parameters in the CISS solver.
1236: Logically Collective on EPS
1238: Input Parameters:
1239: + eps - the eigenproblem solver context
1240: . ip - number of integration points
1241: . bs - block size
1242: . ms - moment size
1243: . npart - number of partitions when splitting the communicator
1244: . bsmax - max block size
1245: - realmats - A and B are real
1247: Options Database Keys:
1248: + -eps_ciss_integration_points - Sets the number of integration points
1249: . -eps_ciss_blocksize - Sets the block size
1250: . -eps_ciss_moments - Sets the moment size
1251: . -eps_ciss_partitions - Sets the number of partitions
1252: . -eps_ciss_maxblocksize - Sets the maximum block size
1253: - -eps_ciss_realmats - A and B are real
1255: Note:
1256: The default number of partitions is 1. This means the internal KSP object is shared
1257: among all processes of the EPS communicator. Otherwise, the communicator is split
1258: into npart communicators, so that npart KSP solves proceed simultaneously.
1260: Level: advanced
1262: .seealso: EPSCISSGetSizes()
1263: @*/
1264: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
1265: {
1276: PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,realmats));
1277: return(0);
1278: }
1282: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
1283: {
1284: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1287: if (ip) *ip = ctx->N;
1288: if (bs) *bs = ctx->L;
1289: if (ms) *ms = ctx->M;
1290: if (npart) *npart = ctx->num_subcomm;
1291: if (bsmax) *bsmax = ctx->L_max;
1292: if (realmats) *realmats = ctx->isreal;
1293: return(0);
1294: }
1298: /*@
1299: EPSCISSGetSizes - Gets the values of various size parameters in the CISS solver.
1301: Not Collective
1303: Input Parameter:
1304: . eps - the eigenproblem solver context
1306: Output Parameters:
1307: + ip - number of integration points
1308: . bs - block size
1309: . ms - moment size
1310: . npart - number of partitions when splitting the communicator
1311: . bsmax - max block size
1312: - realmats - A and B are real
1314: Level: advanced
1316: .seealso: EPSCISSSetSizes()
1317: @*/
1318: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
1319: {
1324: PetscUseMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,realmats));
1325: return(0);
1326: }
1330: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
1331: {
1332: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1335: if (delta == PETSC_DEFAULT) {
1336: ctx->delta = 1e-12;
1337: } else {
1338: if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
1339: ctx->delta = delta;
1340: }
1341: if (spur == PETSC_DEFAULT) {
1342: ctx->spurious_threshold = 1e-4;
1343: } else {
1344: if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
1345: ctx->spurious_threshold = spur;
1346: }
1347: return(0);
1348: }
1352: /*@
1353: EPSCISSSetThreshold - Sets the values of various threshold parameters in
1354: the CISS solver.
1356: Logically Collective on EPS
1358: Input Parameters:
1359: + eps - the eigenproblem solver context
1360: . delta - threshold for numerical rank
1361: - spur - spurious threshold (to discard spurious eigenpairs)
1363: Options Database Keys:
1364: + -eps_ciss_delta - Sets the delta
1365: - -eps_ciss_spurious_threshold - Sets the spurious threshold
1367: Level: advanced
1369: .seealso: EPSCISSGetThreshold()
1370: @*/
1371: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
1372: {
1379: PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
1380: return(0);
1381: }
1385: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
1386: {
1387: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1390: if (delta) *delta = ctx->delta;
1391: if (spur) *spur = ctx->spurious_threshold;
1392: return(0);
1393: }
1397: /*@
1398: EPSCISSGetThreshold - Gets the values of various threshold parameters
1399: in the CISS solver.
1401: Not Collective
1403: Input Parameter:
1404: . eps - the eigenproblem solver context
1406: Output Parameters:
1407: + delta - threshold for numerical rank
1408: - spur - spurious threshold (to discard spurious eigenpairs)
1410: Level: advanced
1412: .seealso: EPSCISSSetThreshold()
1413: @*/
1414: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
1415: {
1420: PetscUseMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
1421: return(0);
1422: }
1426: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt blsize)
1427: {
1428: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1431: if (inner == PETSC_DEFAULT) {
1432: ctx->refine_inner = 0;
1433: } else {
1434: if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
1435: ctx->refine_inner = inner;
1436: }
1437: if (blsize == PETSC_DEFAULT) {
1438: ctx->refine_blocksize = 0;
1439: } else {
1440: if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
1441: ctx->refine_blocksize = blsize;
1442: }
1443: return(0);
1444: }
1448: /*@
1449: EPSCISSSetRefinement - Sets the values of various refinement parameters
1450: in the CISS solver.
1452: Logically Collective on EPS
1454: Input Parameters:
1455: + eps - the eigenproblem solver context
1456: . inner - number of iterative refinement iterations (inner loop)
1457: - blsize - number of iterative refinement iterations (blocksize loop)
1459: Options Database Keys:
1460: + -eps_ciss_refine_inner - Sets number of inner iterations
1461: - -eps_ciss_refine_blocksize - Sets number of blocksize iterations
1463: Level: advanced
1465: .seealso: EPSCISSGetRefinement()
1466: @*/
1467: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt blsize)
1468: {
1475: PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt),(eps,inner,blsize));
1476: return(0);
1477: }
1481: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *blsize)
1482: {
1483: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1486: if (inner) *inner = ctx->refine_inner;
1487: if (blsize) *blsize = ctx->refine_blocksize;
1488: return(0);
1489: }
1493: /*@
1494: EPSCISSGetRefinement - Gets the values of various refinement parameters
1495: in the CISS solver.
1497: Not Collective
1499: Input Parameter:
1500: . eps - the eigenproblem solver context
1502: Output Parameters:
1503: + inner - number of iterative refinement iterations (inner loop)
1504: - blsize - number of iterative refinement iterations (blocksize loop)
1506: Level: advanced
1508: .seealso: EPSCISSSetRefinement()
1509: @*/
1510: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *blsize)
1511: {
1516: PetscUseMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*),(eps,inner,blsize));
1517: return(0);
1518: }
1522: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
1523: {
1524: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1527: ctx->usest = usest;
1528: ctx->usest_set = PETSC_TRUE;
1529: return(0);
1530: }
1534: /*@
1535: EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
1536: use the ST object for the linear solves.
1538: Logically Collective on EPS
1540: Input Parameters:
1541: + eps - the eigenproblem solver context
1542: - usest - boolean flag to use the ST object or not
1544: Options Database Keys:
1545: . -eps_ciss_usest <bool> - whether the ST object will be used or not
1547: Level: advanced
1549: .seealso: EPSCISSGetUseST()
1550: @*/
1551: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
1552: {
1558: PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
1559: return(0);
1560: }
1564: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
1565: {
1566: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1569: *usest = ctx->usest;
1570: return(0);
1571: }
1575: /*@
1576: EPSCISSGetUseST - Gets the flag for using the ST object
1577: in the CISS solver.
1579: Not Collective
1581: Input Parameter:
1582: . eps - the eigenproblem solver context
1584: Output Parameters:
1585: . usest - boolean flag indicating if the ST object is being used
1587: Level: advanced
1589: .seealso: EPSCISSSetUseST()
1590: @*/
1591: PetscErrorCode EPSCISSGetUseST(EPS eps,PetscBool *usest)
1592: {
1598: PetscUseMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
1599: return(0);
1600: }
1604: static PetscErrorCode EPSCISSSetQuadRule_CISS(EPS eps,EPSCISSQuadRule quad)
1605: {
1606: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1609: ctx->quad = quad;
1610: return(0);
1611: }
1615: /*@
1616: EPSCISSSetQuadRule - Sets the quadrature rule used in the CISS solver.
1618: Logically Collective on EPS
1620: Input Parameters:
1621: + eps - the eigenproblem solver context
1622: - quad - the quadrature rule
1624: Options Database Key:
1625: . -eps_ciss_quadrule - Sets the quadrature rule (either 'trapezoidal' or
1626: 'chebyshev')
1628: Notes:
1629: By default, the trapezoidal rule is used (EPS_CISS_QUADRULE_TRAPEZOIDAL).
1631: If the 'chebyshev' option is specified (EPS_CISS_QUADRULE_CHEBYSHEV), then
1632: Chebyshev points are used as quadrature points.
1634: Level: advanced
1636: .seealso: EPSCISSGetQuadRule(), EPSCISSQuadRule
1637: @*/
1638: PetscErrorCode EPSCISSSetQuadRule(EPS eps,EPSCISSQuadRule quad)
1639: {
1645: PetscTryMethod(eps,"EPSCISSSetQuadRule_C",(EPS,EPSCISSQuadRule),(eps,quad));
1646: return(0);
1647: }
1651: static PetscErrorCode EPSCISSGetQuadRule_CISS(EPS eps,EPSCISSQuadRule *quad)
1652: {
1653: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1656: *quad = ctx->quad;
1657: return(0);
1658: }
1662: /*@
1663: EPSCISSGetQuadRule - Gets the quadrature rule used in the CISS solver.
1664:
1665: Not Collective
1667: Input Parameter:
1668: . eps - the eigenproblem solver context
1670: Output Parameters:
1671: . quad - quadrature rule
1673: Level: advanced
1675: .seealso: EPSCISSSetQuadRule() EPSCISSQuadRule
1676: @*/
1677: PetscErrorCode EPSCISSGetQuadRule(EPS eps, EPSCISSQuadRule *quad)
1678: {
1684: PetscUseMethod(eps,"EPSCISSGetQuadRule_C",(EPS,EPSCISSQuadRule*),(eps,quad));
1685: return(0);
1686: }
1690: static PetscErrorCode EPSCISSSetExtraction_CISS(EPS eps,EPSCISSExtraction extraction)
1691: {
1692: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1695: ctx->extraction = extraction;
1696: return(0);
1697: }
1701: /*@
1702: EPSCISSSetExtraction - Sets the extraction technique used in the CISS solver.
1704: Logically Collective on EPS
1706: Input Parameters:
1707: + eps - the eigenproblem solver context
1708: - extraction - the extraction technique
1710: Options Database Key:
1711: . -eps_ciss_extraction - Sets the extraction technique (either 'ritz' or
1712: 'hankel')
1714: Notes:
1715: By default, the Rayleigh-Ritz extraction is used (EPS_CISS_EXTRACTION_RITZ).
1717: If the 'hankel' option is specified (EPS_CISS_EXTRACTION_HANKEL), then
1718: the Block Hankel method is used for extracting eigenpairs.
1720: Level: advanced
1722: .seealso: EPSCISSGetExtraction(), EPSCISSExtraction
1723: @*/
1724: PetscErrorCode EPSCISSSetExtraction(EPS eps,EPSCISSExtraction extraction)
1725: {
1731: PetscTryMethod(eps,"EPSCISSSetExtraction_C",(EPS,EPSCISSExtraction),(eps,extraction));
1732: return(0);
1733: }
1737: static PetscErrorCode EPSCISSGetExtraction_CISS(EPS eps,EPSCISSExtraction *extraction)
1738: {
1739: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1742: *extraction = ctx->extraction;
1743: return(0);
1744: }
1748: /*@
1749: EPSCISSGetExtraction - Gets the extraction technique used in the CISS solver.
1751: Not Collective
1753: Input Parameter:
1754: . eps - the eigenproblem solver context
1756: Output Parameters:
1757: + extraction - extraction technique
1759: Level: advanced
1761: .seealso: EPSCISSSetExtraction() EPSCISSExtraction
1762: @*/
1763: PetscErrorCode EPSCISSGetExtraction(EPS eps,EPSCISSExtraction *extraction)
1764: {
1770: PetscUseMethod(eps,"EPSCISSGetExtraction_C",(EPS,EPSCISSExtraction*),(eps,extraction));
1771: return(0);
1772: }
1777: PetscErrorCode EPSReset_CISS(EPS eps)
1778: {
1780: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1781: PetscInt i;
1784: PetscSubcommDestroy(&ctx->subcomm);
1785: PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
1786: BVDestroy(&ctx->S);
1787: BVDestroy(&ctx->V);
1788: BVDestroy(&ctx->Y);
1789: if (!ctx->usest) {
1790: for (i=0;i<ctx->num_solve_point;i++) {
1791: KSPDestroy(&ctx->ksp[i]);
1792: }
1793: for (i=0;i<ctx->num_solve_point;i++) {
1794: MatDestroy(&ctx->kspMat[i]);
1795: }
1796: PetscFree2(ctx->ksp,ctx->kspMat);
1797: }
1798: VecScatterDestroy(&ctx->scatterin);
1799: VecDestroy(&ctx->xsub);
1800: VecDestroy(&ctx->xdup);
1801: if (ctx->pA) {
1802: MatDestroy(&ctx->pA);
1803: MatDestroy(&ctx->pB);
1804: BVDestroy(&ctx->pV);
1805: }
1806: return(0);
1807: }
1811: PetscErrorCode EPSSetFromOptions_CISS(PetscOptionItems *PetscOptionsObject,EPS eps)
1812: {
1813: PetscErrorCode ierr;
1814: PetscReal r3,r4;
1815: PetscInt i1,i2,i3,i4,i5,i6,i7;
1816: PetscBool b1,b2,flg;
1817: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1818: EPSCISSQuadRule quad;
1819: EPSCISSExtraction extraction;
1822: PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");
1823: EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
1824: PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
1825: PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
1826: PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
1827: PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
1828: PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
1829: PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
1830: EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);
1832: EPSCISSGetThreshold(eps,&r3,&r4);
1833: PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
1834: PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
1835: EPSCISSSetThreshold(eps,r3,r4);
1837: EPSCISSGetRefinement(eps,&i6,&i7);
1838: PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
1839: PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
1840: EPSCISSSetRefinement(eps,i6,i7);
1842: EPSCISSGetUseST(eps,&b2);
1843: PetscOptionsBool("-eps_ciss_usest","CISS use ST for linear solves","EPSCISSSetUseST",b2,&b2,&flg);
1844: if (flg) { EPSCISSSetUseST(eps,b2); }
1846: PetscOptionsEnum("-eps_ciss_quadrule","Quadrature rule","EPSCISSSetQuadRule",EPSCISSQuadRules,(PetscEnum)ctx->quad,(PetscEnum*)&quad,&flg);
1847: if (flg) { EPSCISSSetQuadRule(eps,quad); }
1849: PetscOptionsEnum("-eps_ciss_extraction","Extraction technique","EPSCISSSetExtraction",EPSCISSExtractions,(PetscEnum)ctx->extraction,(PetscEnum*)&extraction,&flg);
1850: if (flg) { EPSCISSSetExtraction(eps,extraction); }
1852: PetscOptionsTail();
1853: return(0);
1854: }
1858: PetscErrorCode EPSDestroy_CISS(EPS eps)
1859: {
1863: PetscFree(eps->data);
1864: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
1865: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
1866: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
1867: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
1868: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
1869: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
1870: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
1871: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
1872: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",NULL);
1873: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",NULL);
1874: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",NULL);
1875: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",NULL);
1876: return(0);
1877: }
1881: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
1882: {
1884: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1885: PetscBool isascii;
1888: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1889: if (isascii) {
1890: PetscViewerASCIIPrintf(viewer," CISS: sizes { integration points: %D, block size: %D, moment size: %D, partitions: %D, maximum block size: %D }\n",ctx->N,ctx->L,ctx->M,ctx->num_subcomm,ctx->L_max);
1891: if (ctx->isreal) {
1892: PetscViewerASCIIPrintf(viewer," CISS: exploiting symmetry of integration points\n");
1893: }
1894: PetscViewerASCIIPrintf(viewer," CISS: threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
1895: PetscViewerASCIIPrintf(viewer," CISS: iterative refinement { inner: %D, blocksize: %D }\n",ctx->refine_inner, ctx->refine_blocksize);
1896: if (ctx->usest) {
1897: PetscViewerASCIIPrintf(viewer," CISS: using ST for linear solves\n");
1898: }
1899: PetscViewerASCIIPrintf(viewer," CISS: extraction: %s\n",EPSCISSExtractions[ctx->extraction]);
1900: PetscViewerASCIIPrintf(viewer," CISS: quadrature rule: %s\n",EPSCISSQuadRules[ctx->quad]);
1901: PetscViewerASCIIPushTab(viewer);
1902:
1903: if (!ctx->usest && ctx->ksp[0]) { KSPView(ctx->ksp[0],viewer); }
1904: PetscViewerASCIIPopTab(viewer);
1905: }
1906: return(0);
1907: }
1911: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
1912: {
1914: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1917: PetscNewLog(eps,&ctx);
1918: eps->data = ctx;
1919: eps->ops->solve = EPSSolve_CISS;
1920: eps->ops->setup = EPSSetUp_CISS;
1921: eps->ops->setfromoptions = EPSSetFromOptions_CISS;
1922: eps->ops->destroy = EPSDestroy_CISS;
1923: eps->ops->reset = EPSReset_CISS;
1924: eps->ops->view = EPSView_CISS;
1925: eps->ops->backtransform = NULL;
1926: eps->ops->computevectors = EPSComputeVectors_Schur;
1927: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
1928: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
1929: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
1930: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
1931: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
1932: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
1933: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
1934: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
1935: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",EPSCISSSetQuadRule_CISS);
1936: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",EPSCISSGetQuadRule_CISS);
1937: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",EPSCISSSetExtraction_CISS);
1938: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",EPSCISSGetExtraction_CISS);
1939: /* set default values of parameters */
1940: ctx->N = 32;
1941: ctx->L = 16;
1942: ctx->M = ctx->N/4;
1943: ctx->delta = 1e-12;
1944: ctx->L_max = 64;
1945: ctx->spurious_threshold = 1e-4;
1946: ctx->usest = PETSC_TRUE;
1947: ctx->usest_set = PETSC_FALSE;
1948: ctx->isreal = PETSC_FALSE;
1949: ctx->refine_inner = 0;
1950: ctx->refine_blocksize = 0;
1951: ctx->num_subcomm = 1;
1952: ctx->quad = (EPSCISSQuadRule)0;
1953: ctx->extraction = EPS_CISS_EXTRACTION_RITZ;
1954: return(0);
1955: }