Actual source code: ciss.c

  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 Tetsuya 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:    Last update: Jun 2013

 26:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 27:    SLEPc - Scalable Library for Eigenvalue Problem Computations
 28:    Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain

 30:    This file is part of SLEPc.

 32:    SLEPc is free software: you can redistribute it and/or modify it under  the
 33:    terms of version 3 of the GNU Lesser General Public License as published by
 34:    the Free Software Foundation.

 36:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
 37:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
 38:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
 39:    more details.

 41:    You  should have received a copy of the GNU Lesser General  Public  License
 42:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
 43:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 44: */

 46: #include <slepc-private/epsimpl.h>                /*I "slepceps.h" I*/
 47: #include <slepcblaslapack.h>

 49: PetscErrorCode EPSSolve_CISS(EPS);

 51: typedef struct {
 52:   /* parameters */
 53:   PetscScalar center;     /* center of the region where to find eigenpairs (default: 0.0) */
 54:   PetscReal   radius;     /* radius of the region (1.0) */
 55:   PetscReal   vscale;     /* vertical scale of the region (1.0; 0.1 if spectrum real) */
 56:   PetscInt    N;          /* number of integration points (32) */
 57:   PetscInt    L;          /* block size (16) */
 58:   PetscInt    M;          /* moment degree (N/4 = 4) */
 59:   PetscReal   delta;      /* threshold of singular value (1e-12) */
 60:   PetscInt    npart;      /* number of partitions of the matrix (1) */
 61:   PetscReal   *sigma;     /* threshold for numerical rank */
 62:   PetscInt    L_max;      /* maximum number of columns of the source matrix V */
 63:   PetscReal   spurious_threshold; /* discard spurious eigenpairs */
 64:   PetscBool   isreal;     /* A and B are real */
 65:   PetscInt    refine_inner;
 66:   PetscInt    refine_outer;
 67:   PetscInt    refine_blocksize;
 68:   /* private data */
 69:   PetscInt    solver_comm_id;
 70:   PetscInt    num_solve_point;
 71:   PetscScalar *weight;
 72:   PetscScalar *omega;
 73:   PetscScalar *pp;
 74:   Vec         *V;
 75:   Vec         *Y;
 76:   Vec         *S;
 77:   KSP         *ksp;
 78:   PetscBool   useconj;
 79:   PetscReal   est_eig;
 80: } EPS_CISS;

 84: static PetscErrorCode SetSolverComm(EPS eps)
 85: {
 86:   EPS_CISS *ctx = (EPS_CISS*)eps->data;
 87:   PetscInt N = ctx->N;

 90:   if (ctx->useconj) N = N/2;
 91:   ctx->solver_comm_id = 0;
 92:   ctx->num_solve_point = N;
 93:   return(0);
 94: }

 98: static PetscErrorCode SetPathParameter(EPS eps)
 99: {
100:   EPS_CISS  *ctx = (EPS_CISS*)eps->data;
101:   PetscInt  i;
102:   PetscReal theta;

105:   for (i=0;i<ctx->N;i++){
106:     theta = ((2*PETSC_PI)/ctx->N)*(i+0.5);
107:     ctx->pp[i] = cos(theta) + PETSC_i*ctx->vscale*sin(theta);
108:     ctx->omega[i] = ctx->center + ctx->radius*ctx->pp[i];
109:     ctx->weight[i] = ctx->vscale*cos(theta) + PETSC_i*sin(theta);
110:   }
111:   return(0);
112: }

116: static PetscErrorCode CISSVecSetRandom(Vec x,PetscRandom rctx)
117: {
119:   PetscInt       j,nlocal;
120:   PetscScalar    *vdata;

123:   SlepcVecSetRandom(x,rctx);
124:   VecGetLocalSize(x,&nlocal);
125:   VecGetArray(x,&vdata);
126:   for (j=0;j<nlocal;j++) {
127:     vdata[j] = PetscRealPart(vdata[j]);
128:     if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
129:     else vdata[j] = 1.0;
130:   }
131:   VecRestoreArray(x,&vdata);
132:   return(0);
133: }

137: static PetscErrorCode SolveLinearSystem(EPS eps)
138: {
140:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
141:   PetscInt       i,j,nmat,p_id;
142:   Mat            A,B,Fz;
143:   PC             pc;
144:   Vec            BV;

147:   STGetNumMatrices(eps->st,&nmat);
148:   STGetOperators(eps->st,0,&A);
149:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
150:   else B = NULL;
151:   MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
152:   VecDuplicate(ctx->V[0],&BV);

154:   for (i=0;i<ctx->num_solve_point;i++) {
155:     p_id = ctx->solver_comm_id * ctx->num_solve_point + i;
156:     MatCopy(A,Fz,DIFFERENT_NONZERO_PATTERN);
157:     if (nmat>1) {
158:       MatAXPY(Fz,-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
159:     } else {
160:       MatShift(Fz,-ctx->omega[p_id]);
161:     }
162:     KSPSetOperators(ctx->ksp[i],Fz,Fz,SAME_NONZERO_PATTERN);
163:     KSPSetType(ctx->ksp[i],KSPPREONLY);
164:     KSPGetPC(ctx->ksp[i],&pc);
165:     PCSetType(pc,PCREDUNDANT);
166:     KSPSetFromOptions(ctx->ksp[i]);
167:     for (j=0;j<ctx->L;j++) {
168:       VecDuplicate(ctx->V[0],&ctx->Y[i*ctx->L_max+j]);
169:       PetscLogObjectParent(eps,ctx->Y[i*ctx->L_max+j]);
170:       if (nmat==2) {
171:         MatMult(B,ctx->V[j],BV);
172:         KSPSolve(ctx->ksp[i],BV,ctx->Y[i*ctx->L_max+j]);
173:       } else {
174:         KSPSolve(ctx->ksp[i],ctx->V[j],ctx->Y[i*ctx->L_max+j]);
175:       }
176:     }
177:   }
178:   MatDestroy(&Fz);
179:   VecDestroy(&BV);
180:   return(0);
181: }

185: static PetscErrorCode ConstructS(EPS eps,PetscInt M,Vec **S)
186: {
188:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
189:   PetscInt       i,j,k;
190:   Vec            v;
191:   PetscScalar    *ppk;

194:   VecDuplicateVecs(ctx->Y[0],M*ctx->L,S);
195:   PetscMalloc(ctx->num_solve_point*sizeof(PetscScalar),&ppk);
196:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
197:   VecDuplicate(ctx->Y[0],&v);
198:   for (k=0;k<M;k++) {
199:     for (j=0;j<ctx->L;j++) {
200:       VecSet(v,0);
201:       for (i=0;i<ctx->num_solve_point; i++) {
202:         VecAXPY(v,ppk[i]*ctx->weight[ctx->solver_comm_id*ctx->num_solve_point+i]/(PetscReal)ctx->N,ctx->Y[i*ctx->L_max+j]);
203:       }
204:       VecCopy(v,(*S)[k*ctx->L+j]);
205:     }
206:     for (i=0;i<ctx->num_solve_point;i++) {
207:       ppk[i] *= ctx->pp[ctx->solver_comm_id*ctx->num_solve_point+i];
208:     }
209:   }
210:   PetscFree(ppk);
211:   VecDestroy(&v);
212:   return(0);
213: }

217: static PetscErrorCode EstimateNumberEigs(EPS eps,Vec *S1,PetscInt *L_add)
218: {
220:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
221:   PetscInt       i,j,istart,p_start,p_end;
222:   PetscScalar    *data,*p_data,tmp,sum = 0.0;
223:   Vec            V_p;
224:   PetscReal      eta;

227:   VecGetOwnershipRange(ctx->V[0],&istart,NULL);
228:   VecGetOwnershipRange(S1[0],&p_start,&p_end);

230:   VecDuplicate(S1[0],&V_p);
231:   for (i=0;i<ctx->L;i++) {
232:     VecGetArray(ctx->V[i],&data);
233:     VecGetArray(V_p,&p_data);
234:     for (j=p_start;j<p_end;j++) p_data[j-p_start] = data[j-istart];
235:     VecRestoreArray(ctx->V[i],&data);
236:     VecRestoreArray(V_p,&p_data);
237:     VecDot(V_p,S1[i],&tmp);
238:     sum += tmp;
239:   }
240:   VecDestroy(&V_p);
241:   ctx->est_eig = PetscAbsScalar(ctx->radius*sum/(PetscReal)ctx->L);
242:   eta = PetscPowReal(10,-log10(eps->tol)/ctx->N);
243:   PetscInfo1(eps,"Estimation_#Eig %F\n",ctx->est_eig);
244:   *L_add = (PetscInt)ceil((ctx->est_eig*eta)/ctx->M) - ctx->L;
245:   if (*L_add < 0) *L_add = 0;
246:   if (*L_add>ctx->L_max-ctx->L) {
247:     PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
248:     *L_add = ctx->L_max-ctx->L;
249:   }
250:   return(0);
251: }

255: static PetscErrorCode SetAddVector(EPS eps,PetscInt Ladd_end)
256: {
258:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
259:   PetscInt       i,j,nlocal,Ladd_start=ctx->L;
260:   Vec            *newV;
261:   PetscScalar    *vdata;

264:   PetscMalloc(Ladd_end*sizeof(Vec*),&newV);
265:   for (i=0;i<ctx->L;i++) { newV[i] = ctx->V[i]; }
266:   PetscFree(ctx->V);
267:   ctx->V = newV;
268:   VecGetLocalSize(ctx->V[0],&nlocal);
269:   for (i=Ladd_start;i<Ladd_end;i++) {
270:     VecDuplicate(ctx->V[0],&ctx->V[i]);
271:     PetscLogObjectParent(eps,ctx->V[i]);
272:     CISSVecSetRandom(ctx->V[i],eps->rand);
273:     VecGetArray(ctx->V[i],&vdata);
274:     for (j=0;j<nlocal;j++) {
275:       vdata[j] = PetscRealPart(vdata[j]);
276:       if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
277:       else vdata[j] = 1.0;
278:     }
279:     VecRestoreArray(ctx->V[i],&vdata);
280:   }
281:   return(0);
282: }

286: static PetscErrorCode SolveAddLinearSystem(EPS eps,PetscInt Ladd_start,PetscInt Ladd_end)
287: {
289:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
290:   PetscInt       i,j;

293:   for (i=0;i<ctx->num_solve_point;i++) {
294:     for (j=Ladd_start;j<Ladd_end;j++) {
295:       VecDestroy(&ctx->Y[i*ctx->L_max+j]);
296:       VecDuplicate(ctx->V[0],&ctx->Y[i*ctx->L_max+j]);
297:       PetscLogObjectParent(eps,ctx->Y[i*ctx->L_max+j]);
298:       KSPSolve(ctx->ksp[i],ctx->V[j],ctx->Y[i*ctx->L_max+j]);
299:     }
300:   }
301:   return(0);
302: }

306: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
307: {
309:   PetscInt       i,j,k,s;
310:   PetscInt       rank_region,icolor,ikey;
311:   PetscScalar    *temp,*temp2,*ppk,alp;
312:   MPI_Comm       Row_Comm;
313:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

316:   MPI_Comm_rank(PetscObjectComm((PetscObject)eps),&rank_region);
317:   icolor = rank_region % ctx->npart;
318:   ikey = rank_region / ctx->npart;
319:   MPI_Comm_split(PetscObjectComm((PetscObject)eps),icolor,ikey,&Row_Comm);

321:   PetscMalloc(ctx->num_solve_point*ctx->L*ctx->L*sizeof(PetscScalar),&temp);
322:   PetscMalloc(2*ctx->M*ctx->L*ctx->L*sizeof(PetscScalar),&temp2);
323:   PetscMalloc(ctx->num_solve_point*sizeof(PetscScalar),&ppk);
324:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
325:   for (i=0; i<ctx->num_solve_point;i++) {
326:     for (j=0;j<ctx->L;j++) {
327:       VecMDot(ctx->Y[i*ctx->L_max+j],ctx->L,ctx->V,&temp[(j+i*ctx->L)*ctx->L]);
328:     }
329:   }

331:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
332:   for (k=0;k<2*ctx->M;k++) {
333:     for (j=0;j<ctx->L;j++) {
334:       for (i=0;i<ctx->num_solve_point;i++) {
335:           alp = ppk[i]*ctx->weight[ctx->solver_comm_id*ctx->num_solve_point+i]/(PetscReal)ctx->N;
336:         for (s=0;s<ctx->L;s++) {
337:           if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
338:           else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
339:         }
340:       }
341:     }
342:     for (i=0;i<ctx->num_solve_point;i++)
343:       ppk[i] *= ctx->pp[ctx->solver_comm_id*ctx->num_solve_point+i];
344:   }
345:   MPI_Allreduce(temp2,Mu,2*ctx->M*ctx->L*ctx->L,MPIU_SCALAR,MPIU_SUM,Row_Comm);

347:   PetscFree(ppk);
348:   PetscFree(temp);
349:   PetscFree(temp2);
350:   return(0);
351: }

355: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,Vec *H)
356: {
357:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
358:   PetscInt       i,j,k,L=ctx->L,M=ctx->M;
359:   PetscScalar    *H_data;

363:   for (k=0;k<L*M;k++) {
364:     VecGetArray(H[k],&H_data);
365:     for (j=0;j<M;j++)
366:       for (i=0;i<L;i++)
367:         H_data[j*L+i] = Mu[i+k*L+(j+s)*L*L];
368:     VecRestoreArray(H[k],&H_data);
369:   }
370:   return(0);
371: }

375: static PetscErrorCode SVD(EPS eps,Vec *Q,PetscInt *K,PetscBool isqr)
376: {
378:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
379:   PetscInt       i,j,k,ld,ml=ctx->L*ctx->M,n=eps->n;
380:   PetscScalar    *R,*w,*s;
381:   DS             ds;

384:   if (isqr) {
385:     PetscMalloc(ml*ml*sizeof(PetscScalar),&s);
386:     PetscMemzero(s,ml*ml*sizeof(PetscScalar));
387:     IPQRDecomposition(eps->ip,Q,0,ml,s,ml);
388:   }

390:   DSCreate(PETSC_COMM_WORLD,&ds);
391:   DSSetType(ds,DSSVD);
392:   DSSetFromOptions(ds);
393:   ld = ml;
394:   DSAllocate(ds,ld);
395:   k = PetscMin(n,ml);
396:   DSSetDimensions(ds,k,ml,0,0);
397:   DSGetArray(ds,DS_MAT_A,&R);
398:   if (isqr) {
399:     for (i=0;i<ml;i++)
400:       for (j=0;j<k;j++)
401:         R[i*ld+j] = s[i*ml+j];
402:   } else {
403:     for (i=0;i<ml;i++) {
404:       VecGetArray(Q[i],&s);
405:       for (j=0;j<k;j++) {
406:         R[i*ld+j] = s[j];
407:       }
408:       VecRestoreArray(Q[i],&s);
409:     }
410:   }
411:   DSRestoreArray(ds,DS_MAT_A,&R);
412:   if (isqr) { PetscFree(s); }
413:   DSSetState(ds,DS_STATE_RAW);
414:   PetscMalloc(k*sizeof(PetscScalar),&w);
415:   DSSetEigenvalueComparison(ds,SlepcCompareLargestReal,NULL);
416:   DSSolve(ds,w,NULL);
417:   DSSort(ds,w,NULL,NULL,NULL,NULL);
418:   (*K) = 0;
419:   for (i=0;i<k;i++) {
420:     ctx->sigma[i] = PetscRealPart(w[i]);
421:     if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
422:   }
423:   PetscFree(w);
424:   DSDestroy(&ds);
425:   return(0);
426: }

430: static PetscErrorCode ProjectMatrix(Mat A,PetscInt nv,PetscInt ld,Vec *Q,PetscScalar *H,Vec w,PetscBool isherm)
431: {
433:   PetscInt       i,j;

436:   if (isherm) {
437:     for (j=0;j<nv;j++) {
438:       MatMult(A,Q[j],w);
439:       VecMDot(w,j+1,Q,H+j*ld);
440:       for (i=0;i<j;i++)
441:         H[j+i*ld] = PetscConj(H[i+j*ld]);
442:     }
443:   } else {
444:     for (j=0;j<nv;j++) {
445:       MatMult(A,Q[j],w);
446:       VecMDot(w,nv,Q,H+j*ld);
447:     }
448:   }
449:   return(0);
450: }

454: static PetscErrorCode isInsideGamma(EPS eps,PetscInt nv,PetscBool *fl)
455: {
456:   EPS_CISS    *ctx = (EPS_CISS*)eps->data;
457:   PetscInt    i;
458:   PetscScalar d;
459:   PetscReal   dx,dy;
460:   for (i=0;i<nv;i++) {
461:     d = (eps->eigr[i]-ctx->center)/ctx->radius;
462:     dx = PetscRealPart(d);
463:     dy = PetscImaginaryPart(d);
464:     if ((dx*dx+(dy*dy)/(ctx->vscale*ctx->vscale))<=1) fl[i] = PETSC_TRUE;
465:     else fl[i] = PETSC_FALSE;
466:   }
467:   return(0);
468: }

472: PetscErrorCode EPSSetUp_CISS(EPS eps)
473: {
475:   PetscInt       i;
476:   Vec            stemp;
477:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
478:   const char     *prefix;

481: #if !defined(PETSC_USE_COMPLEX)
482:   SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS only works for complex scalars");
483: #endif
484:   eps->ncv = PetscMin(eps->n,ctx->L*ctx->M);
485:   if (!eps->mpd) eps->mpd = eps->ncv;
486:   if (!eps->which) eps->which = EPS_ALL;
487:   if (!eps->extraction) {
488:     EPSSetExtraction(eps,EPS_RITZ);
489:   } else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
490:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");

492:   if (ctx->isreal && PetscImaginaryPart(ctx->center) == 0.0) ctx->useconj = PETSC_TRUE;
493:   else ctx->useconj = PETSC_FALSE;

495:   if (!ctx->delta) ctx->delta = PetscMin((eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL*1e-1:eps->tol*1e-1),1e-12);

497:   if (!ctx->vscale) {
498:     if (eps->ishermitian && (eps->ispositive || !eps->isgeneralized) && PetscImaginaryPart(ctx->center) == 0.0) ctx->vscale = 0.1;
499:     else ctx->vscale = 1.0;
500:   }

502:   /* create split comm */
503:   SetSolverComm(eps);

505:   EPSAllocateSolution(eps);
506:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->weight);
507:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->omega);
508:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->pp);
509:   PetscLogObjectMemory(eps,3*ctx->N*sizeof(PetscScalar));
510:   PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);

512:   /* create a template vector for Vecs on solver communicator */
513:   VecCreateMPI(PetscObjectComm((PetscObject)eps),PETSC_DECIDE,eps->n,&stemp);
514:   VecDuplicateVecs(stemp,ctx->L,&ctx->V);
515:   PetscLogObjectParents(eps,ctx->L,ctx->V);
516:   VecDestroy(&stemp);

518:   PetscMalloc(ctx->num_solve_point*sizeof(KSP),&ctx->ksp);
519:   PetscLogObjectMemory(eps,ctx->num_solve_point*sizeof(KSP));
520:   for (i=0;i<ctx->num_solve_point;i++) {
521:     KSPCreate(PetscObjectComm((PetscObject)eps),&ctx->ksp[i]);
522:     PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
523:     PetscLogObjectParent(eps,ctx->ksp[i]);
524:     KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
525:     EPSGetOptionsPrefix(eps,&prefix);
526:     KSPAppendOptionsPrefix(ctx->ksp[i],prefix);
527:   }
528:   PetscMalloc(ctx->num_solve_point*ctx->L_max*sizeof(Vec),&ctx->Y);
529:   PetscMemzero(ctx->Y,ctx->num_solve_point*ctx->L_max*sizeof(Vec));
530:   PetscLogObjectMemory(eps,ctx->num_solve_point*ctx->L_max*sizeof(Vec));

532:   if (eps->isgeneralized) {
533:     if (eps->ishermitian && eps->ispositive) {
534:       DSSetType(eps->ds,DSGHEP);
535:     } else {
536:       DSSetType(eps->ds,DSGNHEP);
537:     }
538:   } else {
539:     if (eps->ishermitian) {
540:       DSSetType(eps->ds,DSHEP);
541:     } else {
542:       DSSetType(eps->ds,DSNHEP);
543:     }
544:   }
545:   DSAllocate(eps->ds,eps->ncv);
546:   EPSSetWorkVecs(eps,2);

548:   /* dispatch solve method */
549:   if (eps->leftvecs) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Left vectors not supported in this solver");
550:   eps->ops->solve = EPSSolve_CISS;
551:   return(0);
552: }

556: PetscErrorCode EPSSolve_CISS(EPS eps)
557: {
559:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
560:   PetscInt       i,j,k,ld,nv,nmat,nvecs,L_add=0,inner,outer,L_base=ctx->L;
561:   PetscScalar    *H,*rr,*pX,*tdata,*vdata,*Mu;
562:   PetscReal      *tau,s1,s2,tau_max=0.0,*temp,error,max_error;
563:   PetscBool      *fl;
564:   Mat            A,B;
565:   Vec            w=eps->work[0],tempv=eps->work[1],*H0,aux;

568:   DSGetLeadingDimension(eps->ds,&ld);
569:   STGetNumMatrices(eps->st,&nmat);
570:   STGetOperators(eps->st,0,&A);
571:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
572:   else B = NULL;

574:   SetPathParameter(eps);
575:   for (i=0;i<ctx->L;i++) {
576:     CISSVecSetRandom(ctx->V[i],eps->rand);
577:   }
578:   SolveLinearSystem(eps);
579:   ConstructS(eps,1,&ctx->S);
580:   nvecs = ctx->L;
581:   EstimateNumberEigs(eps,ctx->S,&L_add);

583:   if (L_add>0) {
584:     PetscInfo2(eps,"Changing L %d -> %d by Estimate #Eig\n",ctx->L,ctx->L+L_add);
585:     SetAddVector(eps,ctx->L+L_add);
586:     SolveAddLinearSystem(eps,ctx->L,ctx->L+L_add);
587:     ctx->L += L_add;
588:     PetscFree(ctx->sigma);
589:     PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);
590:   }

592:   for (i=0;i<ctx->refine_blocksize;i++) {
593:     PetscMalloc(ctx->L*ctx->L*ctx->M*2*sizeof(PetscScalar),&Mu);
594:     CalcMu(eps,Mu);
595:     VecCreateMPI(PetscObjectComm((PetscObject)eps),PETSC_DECIDE,ctx->L*ctx->M,&aux);
596:     VecDuplicateVecs(aux,ctx->L*ctx->M,&H0);
597:     VecDestroy(&aux);
598:     BlockHankel(eps,Mu,0,H0);
599:     SVD(eps,H0,&nv,PETSC_FALSE);
600:     PetscFree(Mu);
601:     VecDestroyVecs(ctx->L*ctx->M,&H0);
602:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M) break;
603:     L_add = L_base;
604:     PetscInfo2(eps,"Changing L %d -> %d by SVD(H0)\n",ctx->L,ctx->L+L_add);
605:     SetAddVector(eps,ctx->L+L_add);
606:     SolveAddLinearSystem(eps,ctx->L,ctx->L+L_add);
607:     ctx->L += L_add;
608:     PetscFree(ctx->sigma);
609:     PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);
610:   }

612:   if (ctx->L != L_base) {
613:     eps->ncv = PetscMin(eps->n,ctx->L*ctx->M);
614:     eps->mpd = eps->ncv;
615:     EPSAllocateSolution(eps);
616:     DSReset(eps->ds);
617:     DSSetEigenvalueComparison(eps->ds,eps->comparison,eps->comparisonctx);
618:     if (eps->isgeneralized) {
619:       if (eps->ishermitian && eps->ispositive) {
620:         DSSetType(eps->ds,DSGHEP);
621:       } else {
622:         DSSetType(eps->ds,DSGNHEP);
623:       }
624:     } else {
625:       if (eps->ishermitian) {
626:         DSSetType(eps->ds,DSHEP);
627:       } else {
628:         DSSetType(eps->ds,DSNHEP);
629:       }
630:     }
631:     DSAllocate(eps->ds,eps->ncv);
632:     DSGetLeadingDimension(eps->ds,&ld);
633:   }

635:   for (outer=0;outer<=ctx->refine_outer;outer++) {
636:     for (inner=0;inner<=ctx->refine_inner;inner++) {
637:       VecDestroyVecs(nvecs,&ctx->S);
638:       ConstructS(eps,ctx->M,&ctx->S);
639:       nvecs = ctx->M*ctx->L;
640:       SVD(eps,ctx->S,&nv,PETSC_TRUE);
641:       if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
642:         for (i=0;i<ctx->L;i++) {
643:           VecCopy(ctx->S[i],ctx->V[i]);
644:         }
645:         SolveAddLinearSystem(eps,0,ctx->L);
646:       } else break;
647:     }
648:     eps->nconv = 0;
649:     if (nv == 0) break;
650:     DSSetDimensions(eps->ds,nv,0,0,0);
651:     DSSetState(eps->ds,DS_STATE_RAW);

653:     DSGetArray(eps->ds,DS_MAT_A,&H);
654:     ProjectMatrix(A,nv,ld,ctx->S,H,w,eps->ishermitian);
655:     DSRestoreArray(eps->ds,DS_MAT_A,&H);
656: 
657:     if (nmat>1) {
658:       DSGetArray(eps->ds,DS_MAT_B,&H);
659:       ProjectMatrix(B,nv,ld,ctx->S,H,w,eps->ishermitian);
660:       DSRestoreArray(eps->ds,DS_MAT_B,&H);
661:     }
662: 
663:     DSSolve(eps->ds,eps->eigr,NULL);

665:     PetscMalloc(nv*sizeof(PetscReal),&tau);
666:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
667:     DSGetArray(eps->ds,DS_MAT_X,&pX);
668:     for (i=0;i<nv;i++) {
669:       s1 = 0;
670:       s2 = 0;
671:       for (j=0;j<nv;j++) {
672:         s1 += PetscAbsScalar(PetscPowScalar(pX[i*ld+j],2));
673:         s2 += PetscPowScalar(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
674:       }
675:       tau[i] = s1/s2;
676:       tau_max = PetscMax(tau_max,tau[i]);
677:     }
678:     tau_max /= ctx->sigma[0];
679:     DSRestoreArray(eps->ds,DS_MAT_X,&pX);
680:     for (i=0;i<nv;i++) tau[i] /= tau_max;
681:     PetscMalloc(nv*sizeof(PetscBool),&fl);
682:     isInsideGamma(eps,nv,fl);
683:     PetscMalloc(nv*sizeof(PetscScalar),&rr);
684:     for (i=0;i<nv;i++) {
685:       if (fl[i] && tau[i]>=ctx->spurious_threshold*tau_max) {
686:         rr[i] = 1.0;
687:         eps->nconv++;
688:       } else rr[i] = 0.0;
689:     }

691:     PetscFree(tau);
692:     PetscFree(fl);
693:     DSSetEigenvalueComparison(eps->ds,SlepcCompareLargestMagnitude,NULL);
694:     DSSort(eps->ds,eps->eigr,NULL,rr,NULL,&eps->nconv);
695:     DSSetEigenvalueComparison(eps->ds,eps->comparison,eps->comparisonctx);
696:     PetscFree(rr);
697:     for (i=0;i<nv;i++) {
698:       VecCopy(ctx->S[i],eps->V[i]);
699:     }
700: 
701:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
702:     DSGetArray(eps->ds,DS_MAT_X,&pX);
703:     SlepcUpdateVectors(nv,ctx->S,0,eps->nconv,pX,ld,PETSC_FALSE);
704:     if (eps->ishermitian) {  /* compute eigenvectors */
705:       SlepcUpdateVectors(nv,eps->V,0,eps->nconv,pX,ld,PETSC_FALSE);
706:     }
707:     DSRestoreArray(eps->ds,DS_MAT_X,&pX);

709:     max_error = 0.0;
710:     for (i=0;i<eps->nconv;i++) {
711:       VecNormalize(eps->V[i],NULL);
712:       VecNormalize(ctx->S[i],NULL);
713:       EPSComputeRelativeError_Private(eps,eps->eigr[i],0,ctx->S[i],NULL,&error);
714:       max_error = PetscMax(max_error,error);
715:     }
716:     if (max_error <= eps->tol || outer == ctx->refine_outer) break;
717:     PetscMalloc(ctx->L*eps->nconv*sizeof(PetscReal),&temp);
718:     for (i=0;i<ctx->L*eps->nconv;i++) {
719:       PetscRandomGetValueReal(eps->rand,&temp[i]);
720:       temp[i] = 2*temp[i]-1;
721:     }
722: 
723:     for (k=0;k<ctx->L;k++) {
724:       VecGetArray(tempv,&tdata);
725:       for (j=0;j<eps->nconv;j++) {
726:         VecGetArray(ctx->S[j],&vdata);
727:         for (i=0;i<eps->n;i++) {
728:           if (j==0) tdata[i] = vdata[i]*temp[j+eps->nconv*k];
729:           else tdata[i] = tdata[i]+vdata[i]*temp[j+eps->nconv*k];
730:         }
731:         VecRestoreArray(ctx->S[j],&vdata);
732:       }
733:       VecRestoreArray(tempv,&tdata);
734:       VecCopy(tempv,ctx->V[k]);
735:     }
736: 
737:     PetscFree(temp);
738:     SolveAddLinearSystem(eps,0,ctx->L);
739:   }
740:   eps->reason = EPS_CONVERGED_TOL;
741:   return(0);
742: }

746: static PetscErrorCode EPSCISSSetRegion_CISS(EPS eps,PetscScalar center,PetscReal radius,PetscReal vscale)
747: {
748:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

751:   ctx->center = center;
752:   if (radius) {
753:     if (radius == PETSC_DEFAULT) {
754:       ctx->radius = 1.0;
755:     } else {
756:       if (radius<0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The radius argument must be > 0.0");
757:       ctx->radius = radius;
758:     }
759:   }
760:   if (vscale) {
761:     if (vscale<0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The vscale argument must be > 0.0");
762:     ctx->vscale = vscale;
763:   }
764:   return(0);
765: }

769: /*@
770:    EPSCISSSetRegion - Sets the parameters defining the region where eigenvalues
771:    must be computed.

773:    Logically Collective on EPS

775:    Input Parameters:
776: +  eps - the eigenproblem solver context
777: .  center - center of the region
778: .  radius - radius of the region
779: -  vscale - vertical scale of the region

781:    Options Database Keys:
782: +  -eps_ciss_center - Sets the center
783: .  -eps_ciss_radius - Sets the radius
784: -  -eps_ciss_vscale - Sets the vertical scale

786:    Level: advanced

788: .seealso: EPSCISSGetRegion()
789: @*/
790: PetscErrorCode EPSCISSSetRegion(EPS eps,PetscScalar center,PetscReal radius,PetscReal vscale)
791: {

799:   PetscTryMethod(eps,"EPSCISSSetRegion_C",(EPS,PetscScalar,PetscReal,PetscReal),(eps,center,radius,vscale));
800:   return(0);
801: }

805: static PetscErrorCode EPSCISSGetRegion_CISS(EPS eps,PetscScalar *center,PetscReal *radius,PetscReal *vscale)
806: {
807:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

810:   if (center) *center = ctx->center;
811:   if (radius) *radius = ctx->radius;
812:   if (vscale) *vscale = ctx->vscale;
813:   return(0);
814: }

818: /*@
819:    EPSCISSGetRegion - Gets the parameters that define the region where eigenvalues
820:    must be computed.

822:    Not Collective

824:    Input Parameter:
825: .  eps - the eigenproblem solver context

827:    Output Parameters:
828: +  center - center of the region
829: .  radius - radius of the region
830: -  vscale - vertical scale of the region

832:    Level: advanced

834: .seealso: EPSCISSSetRegion()
835: @*/
836: PetscErrorCode EPSCISSGetRegion(EPS eps,PetscScalar *center,PetscReal *radius,PetscReal *vscale)
837: {

842:   PetscTryMethod(eps,"EPSCISSGetRegion_C",(EPS,PetscScalar*,PetscReal*,PetscReal*),(eps,center,radius,vscale));
843:   return(0);
844: }

848: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
849: {
851:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

854:   if (ip) {
855:     if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
856:       if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
857:     } else {
858:       if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
859:       if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
860:       if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
861:     }
862:   }
863:   if (bs) {
864:     if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
865:       ctx->L = 16;
866:     } else {
867:       if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
868:       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");
869:       ctx->L = bs;
870:     }
871:   }
872:   if (ms) {
873:     if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
874:       ctx->M = ctx->N/4;
875:     } else {
876:       if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
877:       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");
878:       ctx->M = ms;
879:     }
880:   }
881:   if (npart) {
882:     if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
883:       ctx->npart = 1;
884:     } else {
885:       if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
886:       ctx->npart = npart;
887:     }
888:   }
889:   if (bsmax) {
890:     if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
891:       ctx->L = 256;
892:     } else {
893:       if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
894:       if (bsmax<ctx->L) ctx->L_max = ctx->L;
895:       else ctx->L_max = bsmax;
896:     }
897:   }
898:   ctx->isreal = isreal;
899:   EPSReset(eps);   /* clean allocated arrays and force new setup */
900:   return(0);
901: }

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

908:    Logically Collective on EPS

910:    Input Parameters:
911: +  eps   - the eigenproblem solver context
912: .  ip    - number of integration points
913: .  bs    - block size
914: .  ms    - moment size
915: .  npart - number of partitions when splitting the communicator
916: .  bsmax - max block size
917: -  isreal - A and B are real

919:    Options Database Keys:
920: +  -eps_ciss_integration_points - Sets the number of integration points
921: .  -eps_ciss_blocksize - Sets the block size
922: .  -eps_ciss_moments - Sets the moment size
923: .  -eps_ciss_partitions - Sets the number of partitions
924: .  -eps_ciss_maxblocksize - Sets the maximum block size
925: -  -eps_ciss_realmats - A and B are real

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

932:    Level: advanced

934: .seealso: EPSCISSGetSizes()
935: @*/
936: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
937: {

948:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,isreal));
949:   return(0);
950: }

954: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
955: {
956:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

959:   if (ip) *ip = ctx->N;
960:   if (bs) *bs = ctx->L;
961:   if (ms) *ms = ctx->M;
962:   if (npart) *npart = ctx->npart;
963:   if (bsmax) *bsmax = ctx->L_max;
964:   if (isreal) *isreal = ctx->isreal;
965:   return(0);
966: }

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

973:    Not Collective

975:    Input Parameter:
976: .  eps - the eigenproblem solver context

978:    Output Parameters:
979: +  ip    - number of integration points
980: .  bs    - block size
981: .  ms    - moment size
982: .  npart - number of partitions when splitting the communicator
983: .  bsmax - max block size
984: -  isreal - A and B are real

986:    Level: advanced

988: .seealso: EPSCISSSetSizes()
989: @*/
990: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
991: {

996:   PetscTryMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,isreal));
997:   return(0);
998: }

1002: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
1003: {
1004:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1007:   if (delta) {
1008:     if (delta == PETSC_DEFAULT) {
1009:       ctx->delta = 1e-12;
1010:     } else {
1011:       if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
1012:       ctx->delta = delta;
1013:     }
1014:   }
1015:   if (spur) {
1016:     if (spur == PETSC_DEFAULT) {
1017:       ctx->spurious_threshold = 1e-4;
1018:     } else {
1019:       if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
1020:       ctx->spurious_threshold = spur;
1021:     }
1022:   }
1023:   return(0);
1024: }

1028: /*@
1029:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
1030:    the CISS solver.

1032:    Logically Collective on EPS

1034:    Input Parameters:
1035: +  eps   - the eigenproblem solver context
1036: .  delta - threshold for numerical rank
1037: -  spur  - spurious threshold (to discard spurious eigenpairs)

1039:    Options Database Keys:
1040: +  -eps_ciss_delta - Sets the delta
1041: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

1043:    Level: advanced

1045: .seealso: EPSCISSGetThreshold()
1046: @*/
1047: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
1048: {

1055:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
1056:   return(0);
1057: }

1061: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
1062: {
1063:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1066:   if (delta) *delta = ctx->delta;
1067:   if (spur)  *spur = ctx->spurious_threshold;
1068:   return(0);
1069: }

1073: /*@
1074:    EPSCISSGetThreshold - Gets the values of various threshold parameters
1075:    in the CISS solver.

1077:    Not Collective

1079:    Input Parameter:
1080: .  eps - the eigenproblem solver context

1082:    Output Parameters:
1083: +  delta - threshold for numerical rank
1084: -  spur  - spurious threshold (to discard spurious eigenpairs)

1086:    Level: advanced

1088: .seealso: EPSCISSSetThreshold()
1089: @*/
1090: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
1091: {

1096:   PetscTryMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
1097:   return(0);
1098: }

1102: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
1103: {
1104:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1107:   if (inner == PETSC_DEFAULT) {
1108:     ctx->refine_inner = 0;
1109:   } else {
1110:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
1111:     ctx->refine_inner = inner;
1112:   }
1113:   if (outer == PETSC_DEFAULT) {
1114:     ctx->refine_outer = 0;
1115:   } else {
1116:     if (outer<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine outer argument must be >= 0");
1117:     ctx->refine_outer = outer;
1118:   }
1119:   if (blsize == PETSC_DEFAULT) {
1120:     ctx->refine_blocksize = 0;
1121:   } else {
1122:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
1123:     ctx->refine_blocksize = blsize;
1124:   }
1125:   return(0);
1126: }

1130: /*@
1131:    EPSCISSSetRefinement - Sets the values of various refinement parameters
1132:    in the CISS solver.

1134:    Logically Collective on EPS

1136:    Input Parameters:
1137: +  eps    - the eigenproblem solver context
1138: .  inner  - number of iterative refinement iterations (inner loop)
1139: .  outer  - number of iterative refinement iterations (outer loop)
1140: -  blsize - number of iterative refinement iterations (blocksize loop)

1142:    Options Database Keys:
1143: +  -eps_ciss_refine_inner - Sets number of inner iterations
1144: .  -eps_ciss_refine_outer - Sets number of outer iterations
1145: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

1147:    Level: advanced

1149: .seealso: EPSCISSGetRefinement()
1150: @*/
1151: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
1152: {

1160:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt,PetscInt),(eps,inner,outer,blsize));
1161:   return(0);
1162: }

1166: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *outer,PetscInt *blsize)
1167: {
1168:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

1171:   if (inner)  *inner = ctx->refine_inner;
1172:   if (outer)  *outer = ctx->refine_outer;
1173:   if (blsize) *blsize = ctx->refine_blocksize;
1174:   return(0);
1175: }

1179: /*@
1180:    EPSCISSGetRefinement - Gets the values of various refinement parameters
1181:    in the CISS solver.

1183:    Not Collective

1185:    Input Parameter:
1186: .  eps - the eigenproblem solver context

1188:    Output Parameters:
1189: +  inner  - number of iterative refinement iterations (inner loop)
1190: .  outer  - number of iterative refinement iterations (outer loop)
1191: -  blsize - number of iterative refinement iterations (blocksize loop)

1193:    Level: advanced

1195: .seealso: EPSCISSSetRefinement()
1196: @*/
1197: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *outer,PetscInt *blsize)
1198: {

1203:   PetscTryMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*,PetscInt*),(eps,inner,outer,blsize));
1204:   return(0);
1205: }

1209: PetscErrorCode EPSReset_CISS(EPS eps)
1210: {
1212:   PetscInt       i;
1213:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1216:   PetscFree(ctx->weight);
1217:   PetscFree(ctx->omega);
1218:   PetscFree(ctx->pp);
1219:   VecDestroyVecs(ctx->L,&ctx->V);
1220:   for (i=0;i<ctx->num_solve_point;i++) {
1221:     KSPDestroy(&ctx->ksp[i]);
1222:   }
1223:   PetscFree(ctx->ksp);
1224:   PetscFree(ctx->sigma);
1225:   for (i=0;i<ctx->num_solve_point*ctx->L_max;i++) {
1226:     VecDestroy(&ctx->Y[i]);
1227:   }
1228:   PetscFree(ctx->Y);
1229:   VecDestroyVecs(ctx->M*ctx->L,&ctx->S);
1230:   EPSReset_Default(eps);
1231:   return(0);
1232: }

1236: PetscErrorCode EPSSetFromOptions_CISS(EPS eps)
1237: {
1239:   PetscScalar    s;
1240:   PetscReal      r1,r2,r3,r4;
1241:   PetscInt       i1=0,i2=0,i3=0,i4=0,i5=0,i6=0,i7=0,i8=0;
1242:   PetscBool      b1=PETSC_FALSE;

1245:   PetscOptionsHead("EPS CISS Options");
1246:   EPSCISSGetRegion(eps,&s,&r1,&r2);
1247:   PetscOptionsReal("-eps_ciss_radius","CISS radius of region","EPSCISSSetRegion",r1,&r1,NULL);
1248:   PetscOptionsScalar("-eps_ciss_center","CISS center of region","EPSCISSSetRegion",s,&s,NULL);
1249:   PetscOptionsReal("-eps_ciss_vscale","CISS vertical scale of region","EPSCISSSetRegion",r2,&r2,NULL);
1250:   EPSCISSSetRegion(eps,s,r1,r2);

1252:   PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
1253:   PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
1254:   PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
1255:   PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
1256:   PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
1257:   PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
1258:   EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

1260:   EPSCISSGetThreshold(eps,&r3,&r4);
1261:   PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
1262:   PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
1263:   EPSCISSSetThreshold(eps,r3,r4);

1265:   EPSCISSGetRefinement(eps,&i6,&i7,&i8);
1266:   PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
1267:   PetscOptionsInt("-eps_ciss_refine_outer","CISS number of outer iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
1268:   PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i8,&i8,NULL);
1269:   EPSCISSSetRefinement(eps,i6,i7,i8);

1271:   PetscOptionsTail();
1272:   return(0);
1273: }

1277: PetscErrorCode EPSDestroy_CISS(EPS eps)
1278: {

1282:   PetscFree(eps->data);
1283:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRegion_C",NULL);
1284:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRegion_C",NULL);
1285:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
1286:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
1287:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
1288:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
1289:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
1290:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
1291:   return(0);
1292: }

1296: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
1297: {
1299:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
1300:   PetscBool      isascii;
1301:   char           str[50];

1304:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1305:   if (isascii) {
1306:     SlepcSNPrintfScalar(str,50,ctx->center,PETSC_FALSE);
1307:     PetscViewerASCIIPrintf(viewer,"  CISS: region { center: %s, radius: %G, vscale: %G }\n",str,ctx->radius,ctx->vscale);
1308:     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->npart,ctx->L_max);
1309:     if (ctx->isreal) {
1310:       PetscViewerASCIIPrintf(viewer,"  CISS: exploiting symmetry of integration points\n");
1311:     }
1312:     PetscViewerASCIIPrintf(viewer,"  CISS: threshold { delta: %G, spurious threshold: %G }\n",ctx->delta,ctx->spurious_threshold);
1313:     PetscViewerASCIIPrintf(viewer,"  CISS: iterative refinement  { inner: %D, outer: %D, blocksize: %D }\n",ctx->refine_inner,ctx->refine_outer, ctx->refine_blocksize);
1314:     PetscViewerASCIIPushTab(viewer);
1315:     KSPView(ctx->ksp[0],viewer);
1316:     PetscViewerASCIIPopTab(viewer);

1318:   }
1319:   return(0);
1320: }

1324: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
1325: {
1327:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

1330:   PetscNewLog(eps,EPS_CISS,&ctx);
1331:   eps->data = ctx;
1332:   eps->ops->setup          = EPSSetUp_CISS;
1333:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
1334:   eps->ops->destroy        = EPSDestroy_CISS;
1335:   eps->ops->reset          = EPSReset_CISS;
1336:   eps->ops->view           = EPSView_CISS;
1337:   eps->ops->backtransform  = PETSC_NULL;
1338:   eps->ops->computevectors = EPSComputeVectors_Schur;
1339:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRegion_C",EPSCISSSetRegion_CISS);
1340:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRegion_C",EPSCISSGetRegion_CISS);
1341:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
1342:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
1343:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
1344:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
1345:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
1346:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
1347:   /* set default values of parameters */
1348:   ctx->center  = 0.0;
1349:   ctx->radius  = 1.0;
1350:   ctx->vscale  = 0.0;
1351:   ctx->N       = 32;
1352:   ctx->L       = 16;
1353:   ctx->M       = ctx->N/4;
1354:   ctx->delta   = 0;
1355:   ctx->npart   = 1;
1356:   ctx->L_max   = 128;
1357:   ctx->spurious_threshold = 1e-4;
1358:   ctx->isreal  = PETSC_FALSE;
1359:   ctx->refine_outer = 1;
1360:   ctx->refine_inner = 1;
1361:   ctx->refine_blocksize = 1;
1362:   return(0);
1363: }