Actual source code: ciss.c
slepc-3.6.1 2015-09-03
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-2015, 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: PetscErrorCode EPSSolve_CISS(EPS);
49: typedef struct {
50: /* parameters */
51: PetscInt N; /* number of integration points (32) */
52: PetscInt L; /* block size (16) */
53: PetscInt M; /* moment degree (N/4 = 4) */
54: PetscReal delta; /* threshold of singular value (1e-12) */
55: PetscInt L_max; /* maximum number of columns of the source matrix V */
56: PetscReal spurious_threshold; /* discard spurious eigenpairs */
57: PetscBool isreal; /* A and B are real */
58: PetscInt refine_inner;
59: PetscInt refine_outer;
60: PetscInt refine_blocksize;
61: /* private data */
62: PetscReal *sigma; /* threshold for numerical rank */
63: PetscInt num_subcomm;
64: PetscInt subcomm_id;
65: PetscInt num_solve_point;
66: PetscScalar *weight;
67: PetscScalar *omega;
68: PetscScalar *pp;
69: BV V;
70: BV S;
71: BV pV;
72: BV Y;
73: Vec xsub;
74: Vec xdup;
75: KSP *ksp;
76: Mat *kspMat;
77: PetscBool useconj;
78: PetscReal est_eig;
79: VecScatter scatterin;
80: Mat pA,pB;
81: PetscSubcomm subcomm;
82: PetscBool usest;
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;
178: PetscScalar center;
179: PetscReal theta,radius,vscale,start_ang,end_ang,width;
180: PetscBool isring=PETSC_FALSE,isellipse=PETSC_FALSE;
183: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
184: if (isellipse) {
185: RGEllipseGetParameters(eps->rg,¢er,&radius,&vscale);
186: } else {
187: PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
188: if (!isring) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Region must be Ellipse or Ring");
189: RGRingGetParameters(eps->rg,¢er,&radius,&vscale,&start_ang,&end_ang,&width);
190: }
191: for (i=0;i<ctx->N;i++) {
192: if (isring) {
193: /* Ring region only supported for complex scalars */
194: #if defined(PETSC_USE_COMPLEX)
195: theta = (PETSC_PI/ctx->N)*(i+0.5);
196: ctx->pp[i] = PetscCosReal(theta);
197: ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
198: theta = (start_ang*2+(end_ang-start_ang)*(PetscCosReal(theta)+1.0))*PETSC_PI;
199: ctx->omega[i] = center + radius*(PetscCosReal(theta)+PETSC_i*vscale*PetscSinReal(theta));
200: #endif
201: } else {
202: #if defined(PETSC_USE_COMPLEX)
203: theta = ((2*PETSC_PI)/ctx->N)*(i+0.5);
204: ctx->pp[i] = PetscCosReal(theta) + PETSC_i*vscale*PetscSinReal(theta);
205: ctx->weight[i] = radius*(vscale*PetscCosReal(theta) + PETSC_i*PetscSinReal(theta))/(PetscReal)ctx->N;
206: ctx->omega[i] = center + radius*ctx->pp[i];
207: #else
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: ctx->omega[i] = center + radius*ctx->pp[i];
212: #endif
213: }
214: }
215: return(0);
216: }
220: static PetscErrorCode CISSVecSetRandom(BV V,PetscInt i0,PetscInt i1,PetscRandom rctx)
221: {
223: PetscInt i,j,nlocal;
224: PetscScalar *vdata;
225: Vec x;
226:
228: BVGetSizes(V,&nlocal,NULL,NULL);
229: for (i=i0;i<i1;i++) {
230: BVSetRandomColumn(V,i,rctx);
231: BVGetColumn(V,i,&x);
232: VecGetArray(x,&vdata);
233: for (j=0;j<nlocal;j++) {
234: vdata[j] = PetscRealPart(vdata[j]);
235: if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
236: else vdata[j] = 1.0;
237: }
238: VecRestoreArray(x,&vdata);
239: BVRestoreColumn(V,i,&x);
240: }
241: return(0);
242: }
246: static PetscErrorCode VecScatterVecs(EPS eps,BV Vin,PetscInt n)
247: {
248: PetscErrorCode ierr;
249: EPS_CISS *ctx = (EPS_CISS*)eps->data;
250: PetscInt i;
251: Vec vi,pvi;
252: const PetscScalar *array;
255: for (i=0;i<n;i++) {
256: BVGetColumn(Vin,i,&vi);
257: VecScatterBegin(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
258: VecScatterEnd(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
259: BVRestoreColumn(Vin,i,&vi);
260: VecGetArrayRead(ctx->xdup,&array);
261: VecPlaceArray(ctx->xsub,array);
262: BVGetColumn(ctx->pV,i,&pvi);
263: VecCopy(ctx->xsub,pvi);
264: BVRestoreColumn(ctx->pV,i,&pvi);
265: VecResetArray(ctx->xsub);
266: VecRestoreArrayRead(ctx->xdup,&array);
267: }
268: return(0);
269: }
273: static PetscErrorCode SolveLinearSystem(EPS eps,Mat A,Mat B,BV V,PetscInt L_start,PetscInt L_end,PetscBool initksp)
274: {
276: EPS_CISS *ctx = (EPS_CISS*)eps->data;
277: PetscInt i,j,p_id;
278: Mat Fz;
279: PC pc;
280: Vec Bvj,vj,yj;
281: KSP ksp;
284: BVCreateVec(V,&Bvj);
285: if (ctx->usest) {
286: MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
287: }
288: if (ctx->usest && ctx->pA) {
289: KSPCreate(PetscSubcommChild(ctx->subcomm),&ksp);
290: }
291: for (i=0;i<ctx->num_solve_point;i++) {
292: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
293: if (!ctx->usest && initksp == PETSC_TRUE) {
294: MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&ctx->kspMat[i]);
295: MatCopy(A,ctx->kspMat[i],DIFFERENT_NONZERO_PATTERN);
296: if (B) {
297: MatAXPY(ctx->kspMat[i],-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
298: } else {
299: MatShift(ctx->kspMat[i],-ctx->omega[p_id]);
300: }
301: KSPSetOperators(ctx->ksp[i],ctx->kspMat[i],ctx->kspMat[i]);
302: KSPSetType(ctx->ksp[i],KSPPREONLY);
303: KSPGetPC(ctx->ksp[i],&pc);
304: PCSetType(pc,PCREDUNDANT);
305: KSPSetFromOptions(ctx->ksp[i]);
306: } else if (ctx->usest && ctx->pA) {
307: MatCopy(A,Fz,DIFFERENT_NONZERO_PATTERN);
308: if (B) {
309: MatAXPY(Fz,-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
310: } else {
311: MatShift(Fz,-ctx->omega[p_id]);
312: }
313: KSPSetOperators(ksp,Fz,Fz);
314: KSPSetType(ksp,KSPPREONLY);
315: KSPGetPC(ksp,&pc);
316: PCSetType(pc,PCREDUNDANT);
317: KSPSetFromOptions(ksp);
318: } else if (ctx->usest && !ctx->pA) {
319: STSetShift(eps->st,ctx->omega[p_id]);
320: STGetKSP(eps->st,&ksp);
321: }
322:
323: for (j=L_start;j<L_end;j++) {
324: BVGetColumn(V,j,&vj);
325: BVGetColumn(ctx->Y,i*ctx->L_max+j,&yj);
326: if (B) {
327: MatMult(B,vj,Bvj);
328: if (ctx->usest) {
329: KSPSolve(ksp,Bvj,yj);
330: } else {
331: KSPSolve(ctx->ksp[i],Bvj,yj);
332: }
333: } else {
334: if (ctx->usest) {
335: KSPSolve(ksp,vj,yj);
336: } else {
337: KSPSolve(ctx->ksp[i],vj,yj);
338: }
339: }
340: BVRestoreColumn(V,j,&vj);
341: BVRestoreColumn(ctx->Y,i*ctx->L_max+j,&yj);
342: }
343: if (ctx->usest && i<ctx->num_solve_point-1) { KSPReset(ksp); }
344: }
345: if (ctx->usest) { MatDestroy(&Fz); }
346: VecDestroy(&Bvj);
347: if (ctx->usest && ctx->pA) {
348: KSPDestroy(&ksp);
349: }
350: return(0);
351: }
353: #if defined(PETSC_USE_COMPLEX)
356: static PetscErrorCode EstimateNumberEigs(EPS eps,PetscInt *L_add)
357: {
359: EPS_CISS *ctx = (EPS_CISS*)eps->data;
360: PetscInt i,j,p_id;
361: PetscScalar tmp,m = 1,sum = 0.0;
362: PetscReal eta;
363: Vec v,vtemp,vj,yj;
366: BVGetColumn(ctx->Y,0,&yj);
367: VecDuplicate(yj,&v);
368: BVRestoreColumn(ctx->Y,0,&yj);
369: BVCreateVec(ctx->V,&vtemp);
370: for (j=0;j<ctx->L;j++) {
371: VecSet(v,0);
372: for (i=0;i<ctx->num_solve_point; i++) {
373: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
374: BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
375: BVMultVec(ctx->Y,ctx->weight[p_id],1,v,&m);
376: }
377: BVGetColumn(ctx->V,j,&vj);
378: if (ctx->pA) {
379: VecSet(vtemp,0);
380: VecScatterBegin(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
381: VecScatterEnd(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
382: VecDot(vj,vtemp,&tmp);
383: } else {
384: VecDot(vj,v,&tmp);
385: }
386: BVRestoreColumn(ctx->V,j,&vj);
387: if (ctx->useconj) sum += PetscRealPart(tmp)*2;
388: else sum += tmp;
389: }
390: ctx->est_eig = PetscAbsScalar(sum/(PetscReal)ctx->L);
391: eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
392: PetscInfo1(eps,"Estimation_#Eig %f\n",(double)ctx->est_eig);
393: *L_add = (PetscInt)PetscCeilReal((ctx->est_eig*eta)/ctx->M) - ctx->L;
394: if (*L_add < 0) *L_add = 0;
395: if (*L_add>ctx->L_max-ctx->L) {
396: PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
397: *L_add = ctx->L_max-ctx->L;
398: }
399: VecDestroy(&v);
400: VecDestroy(&vtemp);
401: return(0);
402: }
403: #endif
407: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
408: {
410: PetscMPIInt sub_size;
411: PetscInt i,j,k,s;
412: PetscScalar *m,*temp,*temp2,*ppk,alp;
413: EPS_CISS *ctx = (EPS_CISS*)eps->data;
414: Mat M;
417: MPI_Comm_size(PetscSubcommChild(ctx->subcomm),&sub_size);
418: PetscMalloc3(ctx->num_solve_point*ctx->L*(ctx->L+1),&temp,2*ctx->M*ctx->L*ctx->L,&temp2,ctx->num_solve_point,&ppk);
419: MatCreateSeqDense(PETSC_COMM_SELF,ctx->L,ctx->L_max*ctx->num_solve_point,NULL,&M);
420: for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
421: BVSetActiveColumns(ctx->Y,0,ctx->L_max*ctx->num_solve_point);
422: if (ctx->pA) {
423: BVSetActiveColumns(ctx->pV,0,ctx->L);
424: BVDot(ctx->Y,ctx->pV,M);
425: } else {
426: BVSetActiveColumns(ctx->V,0,ctx->L);
427: BVDot(ctx->Y,ctx->V,M);
428: }
429: MatDenseGetArray(M,&m);
430: for (i=0;i<ctx->num_solve_point;i++) {
431: for (j=0;j<ctx->L;j++) {
432: for (k=0;k<ctx->L;k++) {
433: temp[k+j*ctx->L+i*ctx->L*ctx->L]=m[k+j*ctx->L+i*ctx->L*ctx->L_max];
434: }
435: }
436: }
437: MatDenseRestoreArray(M,&m);
438: for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
439: for (k=0;k<2*ctx->M;k++) {
440: for (j=0;j<ctx->L;j++) {
441: for (i=0;i<ctx->num_solve_point;i++) {
442: alp = ppk[i]*ctx->weight[i*ctx->subcomm->n + ctx->subcomm_id];
443: for (s=0;s<ctx->L;s++) {
444: if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
445: else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
446: }
447: }
448: }
449: for (i=0;i<ctx->num_solve_point;i++)
450: ppk[i] *= ctx->pp[i*ctx->subcomm->n + ctx->subcomm_id];
451: }
452: for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] /= sub_size;
453: MPI_Allreduce(temp2,Mu,2*ctx->M*ctx->L*ctx->L,MPIU_SCALAR,MPIU_SUM,(PetscObjectComm((PetscObject)eps)));
454: PetscFree3(temp,temp2,ppk);
455: MatDestroy(&M);
456: return(0);
457: }
461: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,PetscScalar *H)
462: {
463: EPS_CISS *ctx = (EPS_CISS*)eps->data;
464: PetscInt i,j,k,L=ctx->L,M=ctx->M;
467: for (k=0;k<L*M;k++)
468: for (j=0;j<M;j++)
469: for (i=0;i<L;i++)
470: H[j*L+i+k*L*M] = Mu[i+k*L+(j+s)*L*L];
471: return(0);
472: }
476: static PetscErrorCode SVD_H0(EPS eps,PetscScalar *S,PetscInt *K)
477: {
478: #if defined(SLEPC_MISSING_LAPACK_GESVD)
480: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
481: #else
483: EPS_CISS *ctx = (EPS_CISS*)eps->data;
484: PetscInt i,ml=ctx->L*ctx->M;
485: PetscBLASInt m,n,lda,ldu,ldvt,lwork,info;
486: PetscScalar *work;
487: #if defined(PETSC_USE_COMPLEX)
488: PetscReal *rwork;
489: #endif
492: PetscMalloc1(5*ml,&work);
493: #if defined(PETSC_USE_COMPLEX)
494: PetscMalloc1(5*ml,&rwork);
495: #endif
496: PetscBLASIntCast(ml,&m);
497: n = m; lda = m; ldu = m; ldvt = m; lwork = 5*m;
498: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
499: #if defined(PETSC_USE_COMPLEX)
500: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
501: #else
502: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
503: #endif
504: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
505: PetscFPTrapPop();
506: (*K) = 0;
507: for (i=0;i<ml;i++) {
508: if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
509: }
510: PetscFree(work);
511: #if defined(PETSC_USE_COMPLEX)
512: PetscFree(rwork);
513: #endif
514: return(0);
515: #endif
516: }
520: static PetscErrorCode ConstructS(EPS eps)
521: {
523: EPS_CISS *ctx = (EPS_CISS*)eps->data;
524: PetscInt i,j,k,vec_local_size,p_id;
525: Vec v,sj,yj;
526: PetscScalar *ppk, *v_data, m = 1;
529: BVGetSizes(ctx->Y,&vec_local_size,NULL,NULL);
530: PetscMalloc1(ctx->num_solve_point,&ppk);
531: for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
532: BVGetColumn(ctx->Y,0,&yj);
533: VecDuplicate(yj,&v);
534: BVRestoreColumn(ctx->Y,0,&yj);
535: for (k=0;k<ctx->M;k++) {
536: for (j=0;j<ctx->L;j++) {
537: VecSet(v,0);
538: for (i=0;i<ctx->num_solve_point;i++) {
539: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
540: BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
541: BVMultVec(ctx->Y,ppk[i]*ctx->weight[p_id],1,v,&m);
542: }
543: if (ctx->useconj) {
544: VecGetArray(v,&v_data);
545: for (i=0;i<vec_local_size;i++) v_data[i] = PetscRealPart(v_data[i])*2;
546: VecRestoreArray(v,&v_data);
547: }
548: BVGetColumn(ctx->S,k*ctx->L+j,&sj);
549: if (ctx->pA) {
550: VecSet(sj,0);
551: VecScatterBegin(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
552: VecScatterEnd(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
553: } else {
554: VecCopy(v,sj);
555: }
556: BVRestoreColumn(ctx->S,k*ctx->L+j,&sj);
557: }
558: for (i=0;i<ctx->num_solve_point;i++) {
559: p_id = i*ctx->subcomm->n + ctx->subcomm_id;
560: ppk[i] *= ctx->pp[p_id];
561: }
562: }
563: PetscFree(ppk);
564: VecDestroy(&v);
565: return(0);
566: }
570: static PetscErrorCode SVD_S(BV S,PetscInt ml,PetscReal delta,PetscReal *sigma,PetscInt *K)
571: {
572: #if defined(SLEPC_MISSING_LAPACK_GESVD)
574: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
575: #else
577: PetscInt i,j,k,local_size;
578: PetscScalar *work,*temp,*B,*tempB,*s_data,*Q1,*Q2,*temp2,alpha=1,beta=0;
579: PetscBLASInt l,m,n,lda,ldu,ldvt,lwork,info,ldb,ldc;
580: #if defined(PETSC_USE_COMPLEX)
581: PetscReal *rwork;
582: #endif
585: BVGetSizes(S,&local_size,NULL,NULL);
586: BVGetArray(S,&s_data);
587: PetscMalloc7(ml*ml,&temp,ml*ml,&temp2,local_size*ml,&Q1,local_size*ml,&Q2,ml*ml,&B,ml*ml,&tempB,5*ml,&work);
588: PetscMemzero(B,ml*ml*sizeof(PetscScalar));
589: #if defined(PETSC_USE_COMPLEX)
590: PetscMalloc1(5*ml,&rwork);
591: #endif
592: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
594: for (i=0;i<ml;i++) {
595: B[i*ml+i]=1;
596: }
598: for (k=0;k<2;k++) {
599: PetscBLASIntCast(local_size,&m);
600: PetscBLASIntCast(ml,&l);
601: n = l; lda = m; ldb = m; ldc = l;
602: if (k == 0) {
603: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,s_data,&lda,s_data,&ldb,&beta,temp,&ldc));
604: } else if ((k%2)==1) {
605: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q1,&lda,Q1,&ldb,&beta,temp,&ldc));
606: } else {
607: PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q2,&lda,Q2,&ldb,&beta,temp,&ldc));
608: }
609: PetscMemzero(temp2,ml*ml*sizeof(PetscScalar));
610: MPI_Allreduce(temp,temp2,ml*ml,MPIU_SCALAR,MPIU_SUM,(PetscObjectComm((PetscObject)S)));
612: PetscBLASIntCast(ml,&m);
613: n = m; lda = m; lwork = 5*m, ldu = 1; ldvt = 1;
614: #if defined(PETSC_USE_COMPLEX)
615: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
616: #else
617: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
618: #endif
619: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
621: PetscBLASIntCast(local_size,&l);
622: PetscBLASIntCast(ml,&n);
623: m = n; lda = l; ldb = m; ldc = l;
624: if (k==0) {
625: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,s_data,&lda,temp2,&ldb,&beta,Q1,&ldc));
626: } else if ((k%2)==1) {
627: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q1,&lda,temp2,&ldb,&beta,Q2,&ldc));
628: } else {
629: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q2,&lda,temp2,&ldb,&beta,Q1,&ldc));
630: }
632: PetscBLASIntCast(ml,&l);
633: m = l; n = l; lda = l; ldb = m; ldc = l;
634: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,B,&lda,temp2,&ldb,&beta,tempB,&ldc));
635: for (i=0;i<ml;i++) {
636: sigma[i] = sqrt(sigma[i]);
637: for (j=0;j<local_size;j++) {
638: if ((k%2)==1) Q2[j+i*local_size]/=sigma[i];
639: else Q1[j+i*local_size]/=sigma[i];
640: }
641: for (j=0;j<ml;j++) {
642: B[j+i*ml]=tempB[j+i*ml]*sigma[i];
643: }
644: }
645: }
647: PetscBLASIntCast(ml,&m);
648: n = m; lda = m; ldu=1; ldvt=1;
649: #if defined(PETSC_USE_COMPLEX)
650: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
651: #else
652: PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
653: #endif
654: if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
656: PetscBLASIntCast(local_size,&l);
657: PetscBLASIntCast(ml,&n);
658: m = n; lda = l; ldb = m; ldc = l;
659: if ((k%2)==1) {
660: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q1,&lda,B,&ldb,&beta,s_data,&ldc));
661: } else {
662: PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q2,&lda,B,&ldb,&beta,s_data,&ldc));
663: }
664:
665: PetscFPTrapPop();
666: BVRestoreArray(S,&s_data);
668: (*K) = 0;
669: for (i=0;i<ml;i++) {
670: if (sigma[i]/PetscMax(sigma[0],1)>delta) (*K)++;
671: }
672: PetscFree7(temp,temp2,Q1,Q2,B,tempB,work);
673: #if defined(PETSC_USE_COMPLEX)
674: PetscFree(rwork);
675: #endif
676: return(0);
677: #endif
678: }
682: static PetscErrorCode isGhost(EPS eps,PetscInt ld,PetscInt nv,PetscBool *fl)
683: {
685: EPS_CISS *ctx = (EPS_CISS*)eps->data;
686: PetscInt i,j;
687: PetscScalar *pX;
688: PetscReal *tau,s1,s2,tau_max=0.0;
691: PetscMalloc1(nv,&tau);
692: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
693: DSGetArray(eps->ds,DS_MAT_X,&pX);
695: for (i=0;i<nv;i++) {
696: s1 = 0;
697: s2 = 0;
698: for (j=0;j<nv;j++) {
699: s1 += PetscAbsScalar(PetscPowScalarInt(pX[i*ld+j],2));
700: s2 += PetscPowRealInt(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
701: }
702: tau[i] = s1/s2;
703: tau_max = PetscMax(tau_max,tau[i]);
704: }
705: DSRestoreArray(eps->ds,DS_MAT_X,&pX);
706: for (i=0;i<nv;i++) {
707: tau[i] /= tau_max;
708: }
709: for (i=0;i<nv;i++) {
710: if (tau[i]>=ctx->spurious_threshold) fl[i] = PETSC_TRUE;
711: else fl[i] = PETSC_FALSE;
712: }
713: PetscFree(tau);
714: return(0);
715: }
719: PetscErrorCode EPSSetUp_CISS(EPS eps)
720: {
722: EPS_CISS *ctx = (EPS_CISS*)eps->data;
723: const char *prefix;
724: PetscInt i;
725: PetscBool issinvert,istrivial,isring,isellipse,flg;
726: PetscScalar center;
727: Mat A;
730: eps->ncv = PetscMin(eps->n,ctx->L_max*ctx->M);
731: if (!eps->mpd) eps->mpd = eps->ncv;
732: if (!eps->which) eps->which = EPS_ALL;
733: if (!eps->extraction) { EPSSetExtraction(eps,EPS_RITZ); }
734: else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
735: if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");
737: /* check region */
738: RGIsTrivial(eps->rg,&istrivial);
739: if (istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"EPSCISS requires a nontrivial region, e.g. -rg_type ellipse ...");
740: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
741: PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
742: if (!isellipse && !isring) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for elliptic or ring regions");
743: if (isring) {
744: #if !defined(PETSC_USE_COMPLEX)
745: SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for elliptic regions");
746: #endif
747: ctx->useconj = PETSC_FALSE;
748: } else {
749: RGEllipseGetParameters(eps->rg,¢er,NULL,NULL);
750: #if defined(PETSC_USE_COMPLEX)
751: if (ctx->isreal && PetscImaginaryPart(center) == 0.0) ctx->useconj = PETSC_TRUE;
752: else ctx->useconj = PETSC_FALSE;
753: #else
754: ctx->useconj = PETSC_FALSE;
755: #endif
756: }
757: /* create split comm */
758: SetSolverComm(eps);
760: EPSAllocateSolution(eps,0);
761: PetscMalloc4(ctx->N,&ctx->weight,ctx->N,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
762: PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));
764: /* allocate basis vectors */
765: BVDuplicateResize(eps->V,ctx->L_max*ctx->M,&ctx->S);
766: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
767: BVDuplicateResize(eps->V,ctx->L_max,&ctx->V);
768: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);
770: STGetOperators(eps->st,0,&A);
771: PetscObjectTypeCompare((PetscObject)A,MATSHELL,&flg);
772: if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell not supported in this solver");
774: CISSRedundantMat(eps);
775: if (ctx->pA) {
776: CISSScatterVec(eps);
777: BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->pV);
778: BVSetSizesFromVec(ctx->pV,ctx->xsub,eps->n);
779: BVSetFromOptions(ctx->pV);
780: BVResize(ctx->pV,ctx->L_max,PETSC_FALSE);
781: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
782: }
784: if (ctx->usest) {
785: PetscObjectTypeCompare((PetscObject)eps->st,STSINVERT,&issinvert);
786: if (!issinvert) { STSetType(eps->st,STSINVERT); }
787: } else {
788: PetscMalloc2(ctx->num_solve_point,&ctx->ksp,ctx->num_solve_point,&ctx->kspMat);
789: PetscLogObjectMemory((PetscObject)eps,ctx->num_solve_point*sizeof(KSP)+ctx->num_solve_point*sizeof(Mat));
790: for (i=0;i<ctx->num_solve_point;i++) {
791: KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
792: PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
793: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->ksp[i]);
794: KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
795: EPSGetOptionsPrefix(eps,&prefix);
796: KSPAppendOptionsPrefix(ctx->ksp[i],prefix);
797: KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
798: }
799: }
801: if (ctx->pA) {
802: BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->Y);
803: BVSetSizesFromVec(ctx->Y,ctx->xsub,eps->n);
804: BVSetFromOptions(ctx->Y);
805: BVResize(ctx->Y,ctx->num_solve_point*ctx->L_max,PETSC_FALSE);
806: } else {
807: BVDuplicateResize(eps->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);
808: }
809: PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);
811: if (eps->ishermitian && eps->ispositive) {
812: DSSetType(eps->ds,DSGHEP);
813: } else {
814: DSSetType(eps->ds,DSGNHEP);
815: }
816: DSAllocate(eps->ds,eps->ncv);
817: EPSSetWorkVecs(eps,2);
819: #if !defined(PETSC_USE_COMPLEX)
820: if (!eps->ishermitian) { PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"); }
821: #endif
823: /* dispatch solve method */
824: eps->ops->solve = EPSSolve_CISS;
825: return(0);
826: }
830: PetscErrorCode EPSSolve_CISS(EPS eps)
831: {
833: EPS_CISS *ctx = (EPS_CISS*)eps->data;
834: Mat A,B,X,M,pA,pB;
835: PetscInt i,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,outer,nlocal,*inside;
836: PetscScalar *Mu,*H0,*rr,*temp;
837: PetscReal error,max_error;
838: PetscBool *fl1;
839: Vec si,w[3];
840: SlepcSC sc;
841: #if defined(PETSC_USE_COMPLEX)
842: PetscBool isellipse;
843: #endif
846: w[0] = eps->work[0];
847: w[1] = NULL;
848: w[2] = eps->work[1];
849: /* override SC settings */
850: DSGetSlepcSC(eps->ds,&sc);
851: sc->comparison = SlepcCompareLargestMagnitude;
852: sc->comparisonctx = NULL;
853: sc->map = NULL;
854: sc->mapobj = NULL;
855: VecGetLocalSize(w[0],&nlocal);
856: DSGetLeadingDimension(eps->ds,&ld);
857: STGetNumMatrices(eps->st,&nmat);
858: STGetOperators(eps->st,0,&A);
859: if (nmat>1) { STGetOperators(eps->st,1,&B); }
860: else B = NULL;
861: SetPathParameter(eps);
862: CISSVecSetRandom(ctx->V,0,ctx->L,eps->rand);
864: if (ctx->pA) {
865: VecScatterVecs(eps,ctx->V,ctx->L);
866: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_TRUE);
867: } else {
868: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_TRUE);
869: }
870: #if defined(PETSC_USE_COMPLEX)
871: PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
872: if (isellipse) {
873: EstimateNumberEigs(eps,&L_add);
874: } else {
875: L_add = 0;
876: }
877: #else
878: L_add = 0;
879: #endif
880: if (L_add>0) {
881: PetscInfo2(eps,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
882: CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,eps->rand);
883: if (ctx->pA) {
884: VecScatterVecs(eps,ctx->V,ctx->L+L_add);
885: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
886: } else {
887: SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
888: }
889: ctx->L += L_add;
890: }
891: PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
892: for (i=0;i<ctx->refine_blocksize;i++) {
893: CalcMu(eps,Mu);
894: BlockHankel(eps,Mu,0,H0);
895: SVD_H0(eps,H0,&nv);
896: if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
897: L_add = L_base;
898: if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
899: PetscInfo2(eps,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
900: CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,eps->rand);
901: if (ctx->pA) {
902: VecScatterVecs(eps,ctx->V,ctx->L+L_add);
903: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
904: } else {
905: SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
906: }
907: ctx->L += L_add;
908: }
909: PetscFree2(Mu,H0);
911: for (outer=0;outer<=ctx->refine_outer;outer++) {
912: for (inner=0;inner<=ctx->refine_inner;inner++) {
913: ConstructS(eps);
914: BVSetActiveColumns(ctx->S,0,ctx->L);
915: BVCopy(ctx->S,ctx->V);
916: SVD_S(ctx->S,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
917: if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
918: if (ctx->pA) {
919: VecScatterVecs(eps,ctx->V,ctx->L);
920: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
921: } else {
922: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
923: }
924: } else break;
925: }
927: eps->nconv = 0;
928: if (nv == 0) break;
929: DSSetDimensions(eps->ds,nv,0,0,0);
930: DSSetState(eps->ds,DS_STATE_RAW);
932: BVSetActiveColumns(ctx->S,0,nv);
933: DSGetMat(eps->ds,DS_MAT_A,&pA);
934: MatZeroEntries(pA);
935: BVMatProject(ctx->S,A,ctx->S,pA);
936: DSRestoreMat(eps->ds,DS_MAT_A,&pA);
937: DSGetMat(eps->ds,DS_MAT_B,&pB);
938: MatZeroEntries(pB);
939: if (B) { BVMatProject(ctx->S,B,ctx->S,pB); }
940: else { MatShift(pB,1); }
941: DSRestoreMat(eps->ds,DS_MAT_B,&pB);
943: DSSolve(eps->ds,eps->eigr,eps->eigi);
944: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
946: PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
947: isGhost(eps,ld,nv,fl1);
948: RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
949: for (i=0;i<nv;i++) {
950: if (fl1[i] && inside[i]>0) {
951: rr[i] = 1.0;
952: eps->nconv++;
953: } else rr[i] = 0.0;
954: }
955: DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
956: PetscFree3(fl1,inside,rr);
957: BVSetActiveColumns(eps->V,0,nv);
958: BVSetActiveColumns(ctx->S,0,nv);
959: BVCopy(ctx->S,eps->V);
961: DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
962: DSGetMat(eps->ds,DS_MAT_X,&X);
963: BVMultInPlace(ctx->S,X,0,eps->nconv);
964: if (eps->ishermitian) {
965: BVMultInPlace(eps->V,X,0,eps->nconv);
966: }
967: MatDestroy(&X);
968: max_error = 0.0;
969: for (i=0;i<eps->nconv;i++) {
970: BVGetColumn(ctx->S,i,&si);
971: VecNormalize(si,NULL);
972: EPSComputeResidualNorm_Private(eps,eps->eigr[i],0,si,NULL,w,&error);
973: (*eps->converged)(eps,eps->eigr[i],0,error,&error,eps->convergedctx);
974: BVRestoreColumn(ctx->S,i,&si);
975: max_error = PetscMax(max_error,error);
976: }
978: if (max_error <= eps->tol || outer == ctx->refine_outer) break;
980: if (eps->nconv > ctx->L) nv = eps->nconv;
981: else if (ctx->L > nv) nv = ctx->L;
982: MatCreateSeqDense(PETSC_COMM_SELF,nv,ctx->L,NULL,&M);
983: MatDenseGetArray(M,&temp);
984: for (i=0;i<ctx->L*nv;i++) {
985: PetscRandomGetValue(eps->rand,&temp[i]);
986: temp[i] = PetscRealPart(temp[i]);
987: }
988: MatDenseRestoreArray(M,&temp);
989: BVSetActiveColumns(ctx->S,0,nv);
990: BVMultInPlace(ctx->S,M,0,ctx->L);
991: MatDestroy(&M);
992: BVSetActiveColumns(ctx->S,0,ctx->L);
993: BVCopy(ctx->S,ctx->V);
994: if (ctx->pA) {
995: VecScatterVecs(eps,ctx->V,ctx->L);
996: SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
997: } else {
998: SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
999: }
1000: }
1001: eps->reason = EPS_CONVERGED_TOL;
1002: return(0);
1003: }
1007: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
1008: {
1010: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1013: if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
1014: if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
1015: } else {
1016: if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
1017: if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
1018: if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
1019: }
1020: if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
1021: ctx->L = 16;
1022: } else {
1023: if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
1024: 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");
1025: ctx->L = bs;
1026: }
1027: if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
1028: ctx->M = ctx->N/4;
1029: } else {
1030: if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
1031: 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");
1032: ctx->M = ms;
1033: }
1034: if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
1035: ctx->num_subcomm = 1;
1036: } else {
1037: if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
1038: ctx->num_subcomm = npart;
1039: }
1040: if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
1041: ctx->L = 256;
1042: } else {
1043: if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
1044: if (bsmax<ctx->L) ctx->L_max = ctx->L;
1045: else ctx->L_max = bsmax;
1046: }
1047: ctx->isreal = isreal;
1048: EPSReset(eps); /* clean allocated arrays and force new setup */
1049: return(0);
1050: }
1054: /*@
1055: EPSCISSSetSizes - Sets the values of various size parameters in the CISS solver.
1057: Logically Collective on EPS
1059: Input Parameters:
1060: + eps - the eigenproblem solver context
1061: . ip - number of integration points
1062: . bs - block size
1063: . ms - moment size
1064: . npart - number of partitions when splitting the communicator
1065: . bsmax - max block size
1066: - isreal - A and B are real
1068: Options Database Keys:
1069: + -eps_ciss_integration_points - Sets the number of integration points
1070: . -eps_ciss_blocksize - Sets the block size
1071: . -eps_ciss_moments - Sets the moment size
1072: . -eps_ciss_partitions - Sets the number of partitions
1073: . -eps_ciss_maxblocksize - Sets the maximum block size
1074: - -eps_ciss_realmats - A and B are real
1076: Note:
1077: The default number of partitions is 1. This means the internal KSP object is shared
1078: among all processes of the EPS communicator. Otherwise, the communicator is split
1079: into npart communicators, so that npart KSP solves proceed simultaneously.
1081: Level: advanced
1083: .seealso: EPSCISSGetSizes()
1084: @*/
1085: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
1086: {
1097: PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,isreal));
1098: return(0);
1099: }
1103: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
1104: {
1105: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1108: if (ip) *ip = ctx->N;
1109: if (bs) *bs = ctx->L;
1110: if (ms) *ms = ctx->M;
1111: if (npart) *npart = ctx->num_subcomm;
1112: if (bsmax) *bsmax = ctx->L_max;
1113: if (isreal) *isreal = ctx->isreal;
1114: return(0);
1115: }
1119: /*@
1120: EPSCISSGetSizes - Gets the values of various size parameters in the CISS solver.
1122: Not Collective
1124: Input Parameter:
1125: . eps - the eigenproblem solver context
1127: Output Parameters:
1128: + ip - number of integration points
1129: . bs - block size
1130: . ms - moment size
1131: . npart - number of partitions when splitting the communicator
1132: . bsmax - max block size
1133: - isreal - A and B are real
1135: Level: advanced
1137: .seealso: EPSCISSSetSizes()
1138: @*/
1139: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
1140: {
1145: PetscTryMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,isreal));
1146: return(0);
1147: }
1151: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
1152: {
1153: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1156: if (delta == PETSC_DEFAULT) {
1157: ctx->delta = 1e-12;
1158: } else {
1159: if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
1160: ctx->delta = delta;
1161: }
1162: if (spur == PETSC_DEFAULT) {
1163: ctx->spurious_threshold = 1e-4;
1164: } else {
1165: if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
1166: ctx->spurious_threshold = spur;
1167: }
1168: return(0);
1169: }
1173: /*@
1174: EPSCISSSetThreshold - Sets the values of various threshold parameters in
1175: the CISS solver.
1177: Logically Collective on EPS
1179: Input Parameters:
1180: + eps - the eigenproblem solver context
1181: . delta - threshold for numerical rank
1182: - spur - spurious threshold (to discard spurious eigenpairs)
1184: Options Database Keys:
1185: + -eps_ciss_delta - Sets the delta
1186: - -eps_ciss_spurious_threshold - Sets the spurious threshold
1188: Level: advanced
1190: .seealso: EPSCISSGetThreshold()
1191: @*/
1192: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
1193: {
1200: PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
1201: return(0);
1202: }
1206: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
1207: {
1208: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1211: if (delta) *delta = ctx->delta;
1212: if (spur) *spur = ctx->spurious_threshold;
1213: return(0);
1214: }
1218: /*@
1219: EPSCISSGetThreshold - Gets the values of various threshold parameters
1220: in the CISS solver.
1222: Not Collective
1224: Input Parameter:
1225: . eps - the eigenproblem solver context
1227: Output Parameters:
1228: + delta - threshold for numerical rank
1229: - spur - spurious threshold (to discard spurious eigenpairs)
1231: Level: advanced
1233: .seealso: EPSCISSSetThreshold()
1234: @*/
1235: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
1236: {
1241: PetscTryMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
1242: return(0);
1243: }
1247: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
1248: {
1249: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1252: if (inner == PETSC_DEFAULT) {
1253: ctx->refine_inner = 0;
1254: } else {
1255: if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
1256: ctx->refine_inner = inner;
1257: }
1258: if (outer == PETSC_DEFAULT) {
1259: ctx->refine_outer = 0;
1260: } else {
1261: if (outer<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine outer argument must be >= 0");
1262: ctx->refine_outer = outer;
1263: }
1264: if (blsize == PETSC_DEFAULT) {
1265: ctx->refine_blocksize = 0;
1266: } else {
1267: if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
1268: ctx->refine_blocksize = blsize;
1269: }
1270: return(0);
1271: }
1275: /*@
1276: EPSCISSSetRefinement - Sets the values of various refinement parameters
1277: in the CISS solver.
1279: Logically Collective on EPS
1281: Input Parameters:
1282: + eps - the eigenproblem solver context
1283: . inner - number of iterative refinement iterations (inner loop)
1284: . outer - number of iterative refinement iterations (outer loop)
1285: - blsize - number of iterative refinement iterations (blocksize loop)
1287: Options Database Keys:
1288: + -eps_ciss_refine_inner - Sets number of inner iterations
1289: . -eps_ciss_refine_outer - Sets number of outer iterations
1290: - -eps_ciss_refine_blocksize - Sets number of blocksize iterations
1292: Level: advanced
1294: .seealso: EPSCISSGetRefinement()
1295: @*/
1296: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
1297: {
1305: PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt,PetscInt),(eps,inner,outer,blsize));
1306: return(0);
1307: }
1311: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *outer,PetscInt *blsize)
1312: {
1313: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1316: if (inner) *inner = ctx->refine_inner;
1317: if (outer) *outer = ctx->refine_outer;
1318: if (blsize) *blsize = ctx->refine_blocksize;
1319: return(0);
1320: }
1324: /*@
1325: EPSCISSGetRefinement - Gets the values of various refinement parameters
1326: in the CISS solver.
1328: Not Collective
1330: Input Parameter:
1331: . eps - the eigenproblem solver context
1333: Output Parameters:
1334: + inner - number of iterative refinement iterations (inner loop)
1335: . outer - number of iterative refinement iterations (outer loop)
1336: - blsize - number of iterative refinement iterations (blocksize loop)
1338: Level: advanced
1340: .seealso: EPSCISSSetRefinement()
1341: @*/
1342: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *outer,PetscInt *blsize)
1343: {
1348: PetscTryMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*,PetscInt*),(eps,inner,outer,blsize));
1349: return(0);
1350: }
1354: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
1355: {
1356: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1359: ctx->usest = usest;
1360: return(0);
1361: }
1365: /*@
1366: EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
1367: use the ST object for the linear solves.
1369: Logically Collective on EPS
1371: Input Parameters:
1372: + eps - the eigenproblem solver context
1373: - usest - boolean flag to use the ST object or not
1375: Options Database Keys:
1376: + -eps_ciss_usest <bool> - whether the ST object will be used or not
1378: Level: advanced
1380: .seealso: EPSCISSGetUseST()
1381: @*/
1382: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
1383: {
1389: PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
1390: return(0);
1391: }
1395: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
1396: {
1397: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1400: *usest = ctx->usest;
1401: return(0);
1402: }
1406: /*@
1407: EPSCISSGetUseST - Gets the flag for using the ST object
1408: in the CISS solver.
1410: Not Collective
1412: Input Parameter:
1413: . eps - the eigenproblem solver context
1415: Output Parameters:
1416: + usest - boolean flag indicating if the ST object is being used
1418: Level: advanced
1420: .seealso: EPSCISSSetUseST()
1421: @*/
1422: PetscErrorCode EPSCISSGetUseST(EPS eps, PetscBool *usest)
1423: {
1428: PetscTryMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
1429: return(0);
1430: }
1434: PetscErrorCode EPSReset_CISS(EPS eps)
1435: {
1437: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1438: PetscInt i;
1441: PetscSubcommDestroy(&ctx->subcomm);
1442: PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
1443: BVDestroy(&ctx->S);
1444: BVDestroy(&ctx->V);
1445: BVDestroy(&ctx->Y);
1446: if (!ctx->usest) {
1447: for (i=0;i<ctx->num_solve_point;i++) {
1448: KSPDestroy(&ctx->ksp[i]);
1449: }
1450: for (i=0;i<ctx->num_solve_point;i++) {
1451: MatDestroy(&ctx->kspMat[i]);
1452: }
1453: PetscFree2(ctx->ksp,ctx->kspMat);
1454: }
1455: VecScatterDestroy(&ctx->scatterin);
1456: VecDestroy(&ctx->xsub);
1457: VecDestroy(&ctx->xdup);
1458: if (ctx->pA) {
1459: MatDestroy(&ctx->pA);
1460: MatDestroy(&ctx->pB);
1461: BVDestroy(&ctx->pV);
1462: }
1463: return(0);
1464: }
1468: PetscErrorCode EPSSetFromOptions_CISS(PetscOptions *PetscOptionsObject,EPS eps)
1469: {
1471: PetscReal r3,r4;
1472: PetscInt i1,i2,i3,i4,i5,i6,i7,i8;
1473: PetscBool b1,b2;
1476: PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");
1477: EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
1478: PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
1479: PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
1480: PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
1481: PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
1482: PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
1483: PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
1484: EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);
1486: EPSCISSGetThreshold(eps,&r3,&r4);
1487: PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
1488: PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
1489: EPSCISSSetThreshold(eps,r3,r4);
1491: EPSCISSGetRefinement(eps,&i6,&i7,&i8);
1492: PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
1493: PetscOptionsInt("-eps_ciss_refine_outer","CISS number of outer iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
1494: PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i8,&i8,NULL);
1495: EPSCISSSetRefinement(eps,i6,i7,i8);
1497: EPSCISSGetUseST(eps,&b2);
1498: PetscOptionsBool("-eps_ciss_usest","CISS use ST for linear solves","EPSCISSSetUseST",b2,&b2,NULL);
1499: EPSCISSSetUseST(eps,b2);
1501: PetscOptionsTail();
1502: return(0);
1503: }
1507: PetscErrorCode EPSDestroy_CISS(EPS eps)
1508: {
1512: PetscFree(eps->data);
1513: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
1514: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
1515: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
1516: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
1517: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
1518: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
1519: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
1520: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
1521: return(0);
1522: }
1526: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
1527: {
1529: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1530: PetscBool isascii;
1533: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1534: if (isascii) {
1535: 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);
1536: if (ctx->isreal) {
1537: PetscViewerASCIIPrintf(viewer," CISS: exploiting symmetry of integration points\n");
1538: }
1539: PetscViewerASCIIPrintf(viewer," CISS: threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
1540: PetscViewerASCIIPrintf(viewer," CISS: iterative refinement { inner: %D, outer: %D, blocksize: %D }\n",ctx->refine_inner,ctx->refine_outer, ctx->refine_blocksize);
1541: if (ctx->usest) {
1542: PetscViewerASCIIPrintf(viewer," CISS: using ST for linear solves\n");
1543: }
1544: PetscViewerASCIIPushTab(viewer);
1545: /*KSPView(ctx->ksp[0],viewer);*/
1546: PetscViewerASCIIPopTab(viewer);
1547: }
1548: return(0);
1549: }
1553: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
1554: {
1556: EPS_CISS *ctx = (EPS_CISS*)eps->data;
1559: PetscNewLog(eps,&ctx);
1560: eps->data = ctx;
1561: eps->ops->setup = EPSSetUp_CISS;
1562: eps->ops->setfromoptions = EPSSetFromOptions_CISS;
1563: eps->ops->destroy = EPSDestroy_CISS;
1564: eps->ops->reset = EPSReset_CISS;
1565: eps->ops->view = EPSView_CISS;
1566: eps->ops->backtransform = NULL;
1567: eps->ops->computevectors = EPSComputeVectors_Schur;
1568: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
1569: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
1570: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
1571: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
1572: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
1573: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
1574: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
1575: PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
1576: /* set default values of parameters */
1577: ctx->N = 32;
1578: ctx->L = 16;
1579: ctx->M = ctx->N/4;
1580: ctx->delta = 1e-12;
1581: ctx->L_max = 64;
1582: ctx->spurious_threshold = 1e-4;
1583: ctx->usest = PETSC_FALSE;
1584: ctx->isreal = PETSC_FALSE;
1585: ctx->refine_outer = 1;
1586: ctx->refine_inner = 1;
1587: ctx->refine_blocksize = 1;
1588: ctx->num_subcomm = 1;
1589: return(0);
1590: }