Actual source code: ciss.c

slepc-3.7.3 2016-09-29
Report Typos and Errors
  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,&center,&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,&center,&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,&center,&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,&center,&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,&center,&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");

843:   /* check region */
844:   RGIsTrivial(eps->rg,&istrivial);
845:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS requires a nontrivial region, e.g. -rg_type ellipse ...");
846:   RGGetComplement(eps->rg,&flg);
847:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"A region with complement flag set is not allowed");
848:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
849:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
850:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
851:   if (!isellipse && !isring && !isinterval) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for interval, elliptic or ring regions");
852:   if (isring) {
853: #if !defined(PETSC_USE_COMPLEX)
854:     SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Ring region only supported for complex scalars");
855: #endif
856:     ctx->useconj = PETSC_FALSE;
857:   }
858:   if (isellipse) {
859:     RGEllipseGetParameters(eps->rg,&center,NULL,NULL);
860: #if defined(PETSC_USE_COMPLEX)
861:     if (ctx->isreal && PetscImaginaryPart(center) == 0.0) ctx->useconj = PETSC_TRUE;
862:     else ctx->useconj = PETSC_FALSE;
863: #else
864:     ctx->useconj = PETSC_FALSE;
865: #endif
866:   }
867:   if (isinterval) {
868:     RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
869: #if defined(PETSC_USE_COMPLEX)
870:     if (ctx->isreal && c==d) ctx->useconj = PETSC_TRUE;
871:     else ctx->useconj = PETSC_FALSE;
872: #else
873:     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");
874:     ctx->useconj = PETSC_FALSE;
875: #endif
876:     if (!ctx->quad && c==d) ctx->quad = EPS_CISS_QUADRULE_CHEBYSHEV;
877:   }
878:   if (!ctx->quad) ctx->quad = EPS_CISS_QUADRULE_TRAPEZOIDAL;
879:   /* create split comm */
880:   SetSolverComm(eps);

882:   EPSAllocateSolution(eps,0);
883:   PetscMalloc4(ctx->N,&ctx->weight,ctx->N+1,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
884:   PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));

886:   /* allocate basis vectors */
887:   BVDuplicateResize(eps->V,ctx->L_max*ctx->M,&ctx->S);
888:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
889:   BVDuplicateResize(eps->V,ctx->L_max,&ctx->V);
890:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);

892:   STGetOperators(eps->st,0,&A);
893:   PetscObjectTypeCompare((PetscObject)A,MATSHELL,&flg);
894:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell is not supported in this solver");

896:   if (!ctx->usest_set) ctx->usest = (ctx->num_subcomm>1)? PETSC_FALSE: PETSC_TRUE;
897:   if (ctx->usest && ctx->num_subcomm>1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"The usest flag is not supported when partitions > 1");

899:   CISSRedundantMat(eps);
900:   if (ctx->pA) {
901:     CISSScatterVec(eps);
902:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->pV);
903:     BVSetSizesFromVec(ctx->pV,ctx->xsub,eps->n);
904:     BVSetFromOptions(ctx->pV);
905:     BVResize(ctx->pV,ctx->L_max,PETSC_FALSE);
906:     PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
907:   }

909:   if (ctx->usest) {
910:     PetscObjectTypeCompare((PetscObject)eps->st,STSINVERT,&issinvert);
911:     if (!issinvert) { STSetType(eps->st,STSINVERT); }
912:   } else {
913:     STSetType(eps->st,STSHIFT);  /* we are not going to use ST, so avoid problems in case the user provided one */
914:     PetscMalloc2(ctx->num_solve_point,&ctx->ksp,ctx->num_solve_point,&ctx->kspMat);
915:     PetscLogObjectMemory((PetscObject)eps,ctx->num_solve_point*sizeof(KSP)+ctx->num_solve_point*sizeof(Mat));
916:     for (i=0;i<ctx->num_solve_point;i++) {
917:       KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
918:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
919:       PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->ksp[i]);
920:       KSPSetOptionsPrefix(ctx->ksp[i],((PetscObject)eps)->prefix);
921:       KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
922:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
923:     }
924:   }

926:   if (ctx->pA) {
927:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->Y);
928:     BVSetSizesFromVec(ctx->Y,ctx->xsub,eps->n);
929:     BVSetFromOptions(ctx->Y);
930:     BVResize(ctx->Y,ctx->num_solve_point*ctx->L_max,PETSC_FALSE);
931:   } else {
932:     BVDuplicateResize(eps->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);
933:   }
934:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);

936:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
937:     DSSetType(eps->ds,DSGNHEP);
938:   } else if (eps->isgeneralized) {
939:     if (eps->ishermitian && eps->ispositive) {
940:       DSSetType(eps->ds,DSGHEP);
941:     } else {
942:       DSSetType(eps->ds,DSGNHEP);
943:     }
944:   } else {
945:     if (eps->ishermitian) {
946:       DSSetType(eps->ds,DSHEP);
947:     } else {
948:       DSSetType(eps->ds,DSNHEP);
949:     }
950:   }
951:   DSAllocate(eps->ds,eps->ncv);
952:   EPSSetWorkVecs(eps,2);

954: #if !defined(PETSC_USE_COMPLEX)
955:   if (!eps->ishermitian) { PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"); }
956: #endif
957:   return(0);
958: }

962: PetscErrorCode EPSSolve_CISS(EPS eps)
963: {
965:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
966:   Mat            A,B,X,M,pA,pB;
967:   PetscInt       i,j,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,nlocal,*inside;
968:   PetscScalar    *Mu,*H0,*H1=NULL,*rr,*temp;
969:   PetscReal      error,max_error;
970:   PetscBool      *fl1;
971:   Vec            si,w[3];
972:   SlepcSC        sc;
973:   PetscRandom    rand;
974: #if defined(PETSC_USE_COMPLEX)
975:   PetscBool      isellipse;
976: #endif

979:   w[0] = eps->work[0];
980:   w[1] = NULL;
981:   w[2] = eps->work[1];
982:   /* override SC settings */
983:   DSGetSlepcSC(eps->ds,&sc);
984:   sc->comparison    = SlepcCompareLargestMagnitude;
985:   sc->comparisonctx = NULL;
986:   sc->map           = NULL;
987:   sc->mapobj        = NULL;
988:   VecGetLocalSize(w[0],&nlocal);
989:   DSGetLeadingDimension(eps->ds,&ld);
990:   STGetNumMatrices(eps->st,&nmat);
991:   STGetOperators(eps->st,0,&A);
992:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
993:   else B = NULL;
994:   SetPathParameter(eps);
995:   CISSVecSetRandom(ctx->V,0,ctx->L);
996:   BVGetRandomContext(ctx->V,&rand);

998:   if (ctx->pA) {
999:     VecScatterVecs(eps,ctx->V,ctx->L);
1000:     SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_TRUE);
1001:   } else {
1002:     SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_TRUE);
1003:   }
1004: #if defined(PETSC_USE_COMPLEX)
1005:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
1006:   if (isellipse) {
1007:     EstimateNumberEigs(eps,&L_add);
1008:   } else {
1009:     L_add = 0;
1010:   }
1011: #else
1012:   L_add = 0;
1013: #endif
1014:   if (L_add>0) {
1015:     PetscInfo2(eps,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
1016:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
1017:     if (ctx->pA) {
1018:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
1019:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
1020:     } else {
1021:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
1022:     }
1023:     ctx->L += L_add;
1024:   }
1025:   PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
1026:   for (i=0;i<ctx->refine_blocksize;i++) {
1027:     CalcMu(eps,Mu);
1028:     BlockHankel(eps,Mu,0,H0);
1029:     SVD_H0(eps,H0,&nv);
1030:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
1031:     L_add = L_base;
1032:     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
1033:     PetscInfo2(eps,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
1034:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
1035:     if (ctx->pA) {
1036:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
1037:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
1038:     } else {
1039:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
1040:     }
1041:     ctx->L += L_add;
1042:   }
1043:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1044:     PetscMalloc1(ctx->L*ctx->M*ctx->L*ctx->M,&H1);
1045:   }

1047:   while (eps->reason == EPS_CONVERGED_ITERATING) {
1048:     eps->its++;
1049:     for (inner=0;inner<=ctx->refine_inner;inner++) {
1050:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1051:         CalcMu(eps,Mu);
1052:         BlockHankel(eps,Mu,0,H0);
1053:         SVD_H0(eps,H0,&nv);
1054:         break;
1055:       } else {
1056:         ConstructS(eps);
1057:         BVSetActiveColumns(ctx->S,0,ctx->L);
1058:         BVCopy(ctx->S,ctx->V);
1059:         SVD_S(ctx->S,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
1060:         if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
1061:           if (ctx->pA) {
1062:             VecScatterVecs(eps,ctx->V,ctx->L);
1063:             SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
1064:           } else {
1065:             SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
1066:           }
1067:         } else break;
1068:       }
1069:     }
1070:     eps->nconv = 0;
1071:     if (nv == 0) eps->reason = EPS_CONVERGED_TOL;
1072:     else {
1073:       DSSetDimensions(eps->ds,nv,0,0,0);
1074:       DSSetState(eps->ds,DS_STATE_RAW);

1076:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1077:         BlockHankel(eps,Mu,0,H0);
1078:         BlockHankel(eps,Mu,1,H1);
1079:         DSGetArray(eps->ds,DS_MAT_A,&temp);
1080:         for (j=0;j<nv;j++) {
1081:           for (i=0;i<nv;i++) {
1082:             temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
1083:           }
1084:         }
1085:         DSRestoreArray(eps->ds,DS_MAT_A,&temp);
1086:         DSGetArray(eps->ds,DS_MAT_B,&temp);
1087:         for (j=0;j<nv;j++) {
1088:           for (i=0;i<nv;i++) {
1089:             temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
1090:           }
1091:         }
1092:         DSRestoreArray(eps->ds,DS_MAT_B,&temp);
1093:       } else {
1094:         BVSetActiveColumns(ctx->S,0,nv);
1095:         DSGetMat(eps->ds,DS_MAT_A,&pA);
1096:         MatZeroEntries(pA);
1097:         BVMatProject(ctx->S,A,ctx->S,pA);
1098:         DSRestoreMat(eps->ds,DS_MAT_A,&pA);
1099:         if (B) {
1100:           DSGetMat(eps->ds,DS_MAT_B,&pB);
1101:           MatZeroEntries(pB);
1102:           BVMatProject(ctx->S,B,ctx->S,pB);
1103:           DSRestoreMat(eps->ds,DS_MAT_B,&pB);
1104:         }
1105:       }

1107:       DSSolve(eps->ds,eps->eigr,eps->eigi);
1108:       DSVectors(eps->ds,DS_MAT_X,NULL,NULL);

1110:       PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
1111:       rescale_eig(eps,nv);
1112:       isGhost(eps,ld,nv,fl1);
1113:       RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
1114:       for (i=0;i<nv;i++) {
1115:         if (fl1[i] && inside[i]>=0) {
1116:           rr[i] = 1.0;
1117:           eps->nconv++;
1118:         } else rr[i] = 0.0;
1119:       }
1120:       DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
1121:       rescale_eig(eps,nv);
1122:       PetscFree3(fl1,inside,rr);
1123:       BVSetActiveColumns(eps->V,0,nv);
1124:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1125:         ConstructS(eps);
1126:         BVSetActiveColumns(ctx->S,0,ctx->L);
1127:         BVCopy(ctx->S,ctx->V);
1128:         BVSetActiveColumns(ctx->S,0,nv);
1129:       }
1130:       BVCopy(ctx->S,eps->V);

1132:       DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
1133:       DSGetMat(eps->ds,DS_MAT_X,&X);
1134:       BVMultInPlace(ctx->S,X,0,eps->nconv);
1135:       if (eps->ishermitian) {
1136:         BVMultInPlace(eps->V,X,0,eps->nconv);
1137:       }
1138:       MatDestroy(&X);
1139:       max_error = 0.0;
1140:       for (i=0;i<eps->nconv;i++) {
1141:         BVGetColumn(ctx->S,i,&si);
1142:         EPSComputeResidualNorm_Private(eps,eps->eigr[i],eps->eigi[i],si,NULL,w,&error);
1143:         (*eps->converged)(eps,eps->eigr[i],eps->eigi[i],error,&error,eps->convergedctx);
1144:         BVRestoreColumn(ctx->S,i,&si);
1145:         max_error = PetscMax(max_error,error);
1146:       }

1148:       if (max_error <= eps->tol) eps->reason = EPS_CONVERGED_TOL;
1149:       else if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
1150:       else {
1151:         if (eps->nconv > ctx->L) {
1152:           MatCreateSeqDense(PETSC_COMM_SELF,eps->nconv,ctx->L,NULL,&M);
1153:           MatDenseGetArray(M,&temp);
1154:           for (i=0;i<ctx->L*eps->nconv;i++) {
1155:             PetscRandomGetValue(rand,&temp[i]);
1156:             temp[i] = PetscRealPart(temp[i]);
1157:           }
1158:           MatDenseRestoreArray(M,&temp);
1159:           BVSetActiveColumns(ctx->S,0,eps->nconv);
1160:           BVMultInPlace(ctx->S,M,0,ctx->L);
1161:           MatDestroy(&M);
1162:           BVSetActiveColumns(ctx->S,0,ctx->L);
1163:           BVCopy(ctx->S,ctx->V);
1164:         }
1165:         if (ctx->pA) {
1166:           VecScatterVecs(eps,ctx->V,ctx->L);
1167:           SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
1168:         } else {
1169:           SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
1170:         }
1171:       }
1172:     }
1173:   }
1174:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
1175:     PetscFree(H1);
1176:   }
1177:   PetscFree2(Mu,H0);
1178:   return(0);
1179: }

1183: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
1184: {
1186:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1189:   if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
1190:     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
1191:   } else {
1192:     if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
1193:     if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
1194:     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
1195:   }
1196:   if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
1197:     ctx->L = 16;
1198:   } else {
1199:     if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
1200:     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");
1201:     ctx->L = bs;
1202:   }
1203:   if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
1204:     ctx->M = ctx->N/4;
1205:   } else {
1206:     if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
1207:     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");
1208:     ctx->M = ms;
1209:   }
1210:   if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
1211:     ctx->num_subcomm = 1;
1212:   } else {
1213:     if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
1214:     ctx->num_subcomm = npart;
1215:   }
1216:   if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
1217:     ctx->L = 256;
1218:   } else {
1219:     if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
1220:     if (bsmax<ctx->L) ctx->L_max = ctx->L;
1221:     else ctx->L_max = bsmax;
1222:   }
1223:   ctx->isreal = realmats;
1224:   EPSReset(eps);   /* clean allocated arrays and force new setup */
1225:   return(0);
1226: }

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

1233:    Logically Collective on EPS

1235:    Input Parameters:
1236: +  eps   - the eigenproblem solver context
1237: .  ip    - number of integration points
1238: .  bs    - block size
1239: .  ms    - moment size
1240: .  npart - number of partitions when splitting the communicator
1241: .  bsmax - max block size
1242: -  realmats - A and B are real

1244:    Options Database Keys:
1245: +  -eps_ciss_integration_points - Sets the number of integration points
1246: .  -eps_ciss_blocksize - Sets the block size
1247: .  -eps_ciss_moments - Sets the moment size
1248: .  -eps_ciss_partitions - Sets the number of partitions
1249: .  -eps_ciss_maxblocksize - Sets the maximum block size
1250: -  -eps_ciss_realmats - A and B are real

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

1257:    Level: advanced

1259: .seealso: EPSCISSGetSizes()
1260: @*/
1261: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
1262: {

1273:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,realmats));
1274:   return(0);
1275: }

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

1284:   if (ip) *ip = ctx->N;
1285:   if (bs) *bs = ctx->L;
1286:   if (ms) *ms = ctx->M;
1287:   if (npart) *npart = ctx->num_subcomm;
1288:   if (bsmax) *bsmax = ctx->L_max;
1289:   if (realmats) *realmats = ctx->isreal;
1290:   return(0);
1291: }

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

1298:    Not Collective

1300:    Input Parameter:
1301: .  eps - the eigenproblem solver context

1303:    Output Parameters:
1304: +  ip    - number of integration points
1305: .  bs    - block size
1306: .  ms    - moment size
1307: .  npart - number of partitions when splitting the communicator
1308: .  bsmax - max block size
1309: -  realmats - A and B are real

1311:    Level: advanced

1313: .seealso: EPSCISSSetSizes()
1314: @*/
1315: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
1316: {

1321:   PetscUseMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,realmats));
1322:   return(0);
1323: }

1327: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
1328: {
1329:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1332:   if (delta == PETSC_DEFAULT) {
1333:     ctx->delta = 1e-12;
1334:   } else {
1335:     if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
1336:     ctx->delta = delta;
1337:   }
1338:   if (spur == PETSC_DEFAULT) {
1339:     ctx->spurious_threshold = 1e-4;
1340:   } else {
1341:     if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
1342:     ctx->spurious_threshold = spur;
1343:   }
1344:   return(0);
1345: }

1349: /*@
1350:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
1351:    the CISS solver.

1353:    Logically Collective on EPS

1355:    Input Parameters:
1356: +  eps   - the eigenproblem solver context
1357: .  delta - threshold for numerical rank
1358: -  spur  - spurious threshold (to discard spurious eigenpairs)

1360:    Options Database Keys:
1361: +  -eps_ciss_delta - Sets the delta
1362: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

1364:    Level: advanced

1366: .seealso: EPSCISSGetThreshold()
1367: @*/
1368: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
1369: {

1376:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
1377:   return(0);
1378: }

1382: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
1383: {
1384:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1387:   if (delta) *delta = ctx->delta;
1388:   if (spur)  *spur = ctx->spurious_threshold;
1389:   return(0);
1390: }

1394: /*@
1395:    EPSCISSGetThreshold - Gets the values of various threshold parameters
1396:    in the CISS solver.

1398:    Not Collective

1400:    Input Parameter:
1401: .  eps - the eigenproblem solver context

1403:    Output Parameters:
1404: +  delta - threshold for numerical rank
1405: -  spur  - spurious threshold (to discard spurious eigenpairs)

1407:    Level: advanced

1409: .seealso: EPSCISSSetThreshold()
1410: @*/
1411: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
1412: {

1417:   PetscUseMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
1418:   return(0);
1419: }

1423: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt blsize)
1424: {
1425:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1428:   if (inner == PETSC_DEFAULT) {
1429:     ctx->refine_inner = 0;
1430:   } else {
1431:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
1432:     ctx->refine_inner = inner;
1433:   }
1434:   if (blsize == PETSC_DEFAULT) {
1435:     ctx->refine_blocksize = 0;
1436:   } else {
1437:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
1438:     ctx->refine_blocksize = blsize;
1439:   }
1440:   return(0);
1441: }

1445: /*@
1446:    EPSCISSSetRefinement - Sets the values of various refinement parameters
1447:    in the CISS solver.

1449:    Logically Collective on EPS

1451:    Input Parameters:
1452: +  eps    - the eigenproblem solver context
1453: .  inner  - number of iterative refinement iterations (inner loop)
1454: -  blsize - number of iterative refinement iterations (blocksize loop)

1456:    Options Database Keys:
1457: +  -eps_ciss_refine_inner - Sets number of inner iterations
1458: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

1460:    Level: advanced

1462: .seealso: EPSCISSGetRefinement()
1463: @*/
1464: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt blsize)
1465: {

1472:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt),(eps,inner,blsize));
1473:   return(0);
1474: }

1478: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *blsize)
1479: {
1480:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1483:   if (inner)  *inner = ctx->refine_inner;
1484:   if (blsize) *blsize = ctx->refine_blocksize;
1485:   return(0);
1486: }

1490: /*@
1491:    EPSCISSGetRefinement - Gets the values of various refinement parameters
1492:    in the CISS solver.

1494:    Not Collective

1496:    Input Parameter:
1497: .  eps - the eigenproblem solver context

1499:    Output Parameters:
1500: +  inner  - number of iterative refinement iterations (inner loop)
1501: -  blsize - number of iterative refinement iterations (blocksize loop)

1503:    Level: advanced

1505: .seealso: EPSCISSSetRefinement()
1506: @*/
1507: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *blsize)
1508: {

1513:   PetscUseMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*),(eps,inner,blsize));
1514:   return(0);
1515: }

1519: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
1520: {
1521:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1524:   ctx->usest     = usest;
1525:   ctx->usest_set = PETSC_TRUE;
1526:   return(0);
1527: }

1531: /*@
1532:    EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
1533:    use the ST object for the linear solves.

1535:    Logically Collective on EPS

1537:    Input Parameters:
1538: +  eps    - the eigenproblem solver context
1539: -  usest  - boolean flag to use the ST object or not

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

1544:    Level: advanced

1546: .seealso: EPSCISSGetUseST()
1547: @*/
1548: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
1549: {

1555:   PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
1556:   return(0);
1557: }

1561: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
1562: {
1563:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1566:   *usest = ctx->usest;
1567:   return(0);
1568: }

1572: /*@
1573:    EPSCISSGetUseST - Gets the flag for using the ST object
1574:    in the CISS solver.

1576:    Not Collective

1578:    Input Parameter:
1579: .  eps - the eigenproblem solver context

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

1584:    Level: advanced

1586: .seealso: EPSCISSSetUseST()
1587: @*/
1588: PetscErrorCode EPSCISSGetUseST(EPS eps,PetscBool *usest)
1589: {

1595:   PetscUseMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
1596:   return(0);
1597: }

1601: static PetscErrorCode EPSCISSSetQuadRule_CISS(EPS eps,EPSCISSQuadRule quad)
1602: {
1603:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1606:   ctx->quad = quad;
1607:   return(0);
1608: }

1612: /*@
1613:    EPSCISSSetQuadRule - Sets the quadrature rule used in the CISS solver. 

1615:    Logically Collective on EPS

1617:    Input Parameters:
1618: +  eps  - the eigenproblem solver context
1619: -  quad - the quadrature rule

1621:    Options Database Key:
1622: .  -eps_ciss_quadrule - Sets the quadrature rule (either 'trapezoidal' or
1623:                            'chebyshev')

1625:    Notes:
1626:    By default, the trapezoidal rule is used (EPS_CISS_QUADRULE_TRAPEZOIDAL).

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

1631:    Level: advanced

1633: .seealso: EPSCISSGetQuadRule(), EPSCISSQuadRule
1634: @*/
1635: PetscErrorCode EPSCISSSetQuadRule(EPS eps,EPSCISSQuadRule quad)
1636: {

1642:   PetscTryMethod(eps,"EPSCISSSetQuadRule_C",(EPS,EPSCISSQuadRule),(eps,quad));
1643:   return(0);
1644: }

1648: static PetscErrorCode EPSCISSGetQuadRule_CISS(EPS eps,EPSCISSQuadRule *quad)
1649: {
1650:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1653:   *quad = ctx->quad;
1654:   return(0);
1655: }

1659: /*@
1660:    EPSCISSGetQuadRule - Gets the quadrature rule used in the CISS solver.
1661:    
1662:    Not Collective

1664:    Input Parameter:
1665: .  eps - the eigenproblem solver context

1667:    Output Parameters:
1668: .  quad - quadrature rule

1670:    Level: advanced

1672: .seealso: EPSCISSSetQuadRule() EPSCISSQuadRule
1673: @*/
1674: PetscErrorCode EPSCISSGetQuadRule(EPS eps, EPSCISSQuadRule *quad)
1675: {

1681:   PetscUseMethod(eps,"EPSCISSGetQuadRule_C",(EPS,EPSCISSQuadRule*),(eps,quad));
1682:   return(0);
1683: }

1687: static PetscErrorCode EPSCISSSetExtraction_CISS(EPS eps,EPSCISSExtraction extraction)
1688: {
1689:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1692:   ctx->extraction = extraction;
1693:   return(0);
1694: }

1698: /*@
1699:    EPSCISSSetExtraction - Sets the extraction technique used in the CISS solver. 

1701:    Logically Collective on EPS

1703:    Input Parameters:
1704: +  eps        - the eigenproblem solver context
1705: -  extraction - the extraction technique

1707:    Options Database Key:
1708: .  -eps_ciss_extraction - Sets the extraction technique (either 'ritz' or
1709:                            'hankel')

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

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

1717:    Level: advanced

1719: .seealso: EPSCISSGetExtraction(), EPSCISSExtraction
1720: @*/
1721: PetscErrorCode EPSCISSSetExtraction(EPS eps,EPSCISSExtraction extraction)
1722: {

1728:   PetscTryMethod(eps,"EPSCISSSetExtraction_C",(EPS,EPSCISSExtraction),(eps,extraction));
1729:   return(0);
1730: }

1734: static PetscErrorCode EPSCISSGetExtraction_CISS(EPS eps,EPSCISSExtraction *extraction)
1735: {
1736:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1739:   *extraction = ctx->extraction;
1740:   return(0);
1741: }

1745: /*@
1746:    EPSCISSGetExtraction - Gets the extraction technique used in the CISS solver.

1748:    Not Collective

1750:    Input Parameter:
1751: .  eps - the eigenproblem solver context

1753:    Output Parameters:
1754: +  extraction - extraction technique

1756:    Level: advanced

1758: .seealso: EPSCISSSetExtraction() EPSCISSExtraction
1759: @*/
1760: PetscErrorCode EPSCISSGetExtraction(EPS eps,EPSCISSExtraction *extraction)
1761: {

1767:   PetscUseMethod(eps,"EPSCISSGetExtraction_C",(EPS,EPSCISSExtraction*),(eps,extraction));
1768:   return(0);
1769: }


1774: PetscErrorCode EPSReset_CISS(EPS eps)
1775: {
1777:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
1778:   PetscInt       i;

1781:   PetscSubcommDestroy(&ctx->subcomm);
1782:   PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
1783:   BVDestroy(&ctx->S);
1784:   BVDestroy(&ctx->V);
1785:   BVDestroy(&ctx->Y);
1786:   if (!ctx->usest) {
1787:     for (i=0;i<ctx->num_solve_point;i++) {
1788:       KSPDestroy(&ctx->ksp[i]);
1789:     }
1790:     for (i=0;i<ctx->num_solve_point;i++) {
1791:       MatDestroy(&ctx->kspMat[i]);
1792:     }
1793:     PetscFree2(ctx->ksp,ctx->kspMat);
1794:   }
1795:   VecScatterDestroy(&ctx->scatterin);
1796:   VecDestroy(&ctx->xsub);
1797:   VecDestroy(&ctx->xdup);
1798:   if (ctx->pA) {
1799:     MatDestroy(&ctx->pA);
1800:     MatDestroy(&ctx->pB);
1801:     BVDestroy(&ctx->pV);
1802:   }
1803:   return(0);
1804: }

1808: PetscErrorCode EPSSetFromOptions_CISS(PetscOptionItems *PetscOptionsObject,EPS eps)
1809: {
1810:   PetscErrorCode    ierr;
1811:   PetscReal         r3,r4;
1812:   PetscInt          i1,i2,i3,i4,i5,i6,i7;
1813:   PetscBool         b1,b2,flg;
1814:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
1815:   EPSCISSQuadRule   quad;
1816:   EPSCISSExtraction extraction;

1819:   PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");
1820:   EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
1821:   PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
1822:   PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
1823:   PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
1824:   PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
1825:   PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
1826:   PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
1827:   EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

1829:   EPSCISSGetThreshold(eps,&r3,&r4);
1830:   PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
1831:   PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
1832:   EPSCISSSetThreshold(eps,r3,r4);

1834:   EPSCISSGetRefinement(eps,&i6,&i7);
1835:   PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
1836:   PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
1837:   EPSCISSSetRefinement(eps,i6,i7);

1839:   EPSCISSGetUseST(eps,&b2);
1840:   PetscOptionsBool("-eps_ciss_usest","CISS use ST for linear solves","EPSCISSSetUseST",b2,&b2,&flg);
1841:   if (flg) { EPSCISSSetUseST(eps,b2); }

1843:   PetscOptionsEnum("-eps_ciss_quadrule","Quadrature rule","EPSCISSSetQuadRule",EPSCISSQuadRules,(PetscEnum)ctx->quad,(PetscEnum*)&quad,&flg);
1844:   if (flg) { EPSCISSSetQuadRule(eps,quad); }

1846:   PetscOptionsEnum("-eps_ciss_extraction","Extraction technique","EPSCISSSetExtraction",EPSCISSExtractions,(PetscEnum)ctx->extraction,(PetscEnum*)&extraction,&flg);
1847:   if (flg) { EPSCISSSetExtraction(eps,extraction); }

1849:   PetscOptionsTail();
1850:   return(0);
1851: }

1855: PetscErrorCode EPSDestroy_CISS(EPS eps)
1856: {

1860:   PetscFree(eps->data);
1861:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
1862:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
1863:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
1864:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
1865:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
1866:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
1867:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
1868:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
1869:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",NULL);
1870:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",NULL);
1871:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",NULL);
1872:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",NULL);
1873:   return(0);
1874: }

1878: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
1879: {
1881:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
1882:   PetscBool      isascii;

1885:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1886:   if (isascii) {
1887:     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);
1888:     if (ctx->isreal) {
1889:       PetscViewerASCIIPrintf(viewer,"  CISS: exploiting symmetry of integration points\n");
1890:     }
1891:     PetscViewerASCIIPrintf(viewer,"  CISS: threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
1892:     PetscViewerASCIIPrintf(viewer,"  CISS: iterative refinement  { inner: %D, blocksize: %D }\n",ctx->refine_inner, ctx->refine_blocksize);
1893:     if (ctx->usest) {
1894:       PetscViewerASCIIPrintf(viewer,"  CISS: using ST for linear solves\n");
1895:     }
1896:     PetscViewerASCIIPrintf(viewer,"  CISS: extraction: %s\n",EPSCISSExtractions[ctx->extraction]);
1897:     PetscViewerASCIIPrintf(viewer,"  CISS: quadrature rule: %s\n",EPSCISSQuadRules[ctx->quad]);
1898:     PetscViewerASCIIPushTab(viewer);
1899:     
1900:     if (!ctx->usest && ctx->ksp[0]) { KSPView(ctx->ksp[0],viewer); }
1901:     PetscViewerASCIIPopTab(viewer);
1902:   }
1903:   return(0);
1904: }

1908: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
1909: {
1911:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1914:   PetscNewLog(eps,&ctx);
1915:   eps->data = ctx;
1916:   eps->ops->solve          = EPSSolve_CISS;
1917:   eps->ops->setup          = EPSSetUp_CISS;
1918:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
1919:   eps->ops->destroy        = EPSDestroy_CISS;
1920:   eps->ops->reset          = EPSReset_CISS;
1921:   eps->ops->view           = EPSView_CISS;
1922:   eps->ops->backtransform  = NULL;
1923:   eps->ops->computevectors = EPSComputeVectors_Schur;
1924:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
1925:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
1926:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
1927:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
1928:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
1929:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
1930:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
1931:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
1932:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",EPSCISSSetQuadRule_CISS);
1933:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",EPSCISSGetQuadRule_CISS);
1934:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",EPSCISSSetExtraction_CISS);
1935:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",EPSCISSGetExtraction_CISS);
1936:   /* set default values of parameters */
1937:   ctx->N                  = 32;
1938:   ctx->L                  = 16;
1939:   ctx->M                  = ctx->N/4;
1940:   ctx->delta              = 1e-12;
1941:   ctx->L_max              = 64;
1942:   ctx->spurious_threshold = 1e-4;
1943:   ctx->usest              = PETSC_TRUE;
1944:   ctx->usest_set          = PETSC_FALSE;
1945:   ctx->isreal             = PETSC_FALSE;
1946:   ctx->refine_inner       = 0;
1947:   ctx->refine_blocksize   = 0;
1948:   ctx->num_subcomm        = 1;
1949:   ctx->quad               = (EPSCISSQuadRule)0;
1950:   ctx->extraction         = EPS_CISS_EXTRACTION_RITZ;
1951:   return(0);
1952: }