Actual source code: nciss.c

slepc-3.6.1 2015-09-03
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-2015, Universitat Politecnica de Valencia, Spain

 28:    This file is part of SLEPc.

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

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

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

 44: #include <slepc/private/nepimpl.h>         /*I "slepcnep.h" I*/
 45: #include <slepcblaslapack.h>

 47: PetscErrorCode NEPSolve_CISS(NEP);

 49: typedef struct {
 50:   /* parameters */
 51:   PetscInt     N;          /* number of integration points (32) */
 52:   PetscInt     L;          /* block size (16) */
 53:   PetscInt     M;          /* moment degree (N/4 = 4) */
 54:   PetscReal    delta;      /* threshold of singular value (1e-12) */
 55:   PetscInt     L_max;      /* maximum number of columns of the source matrix V */
 56:   PetscReal    spurious_threshold; /* discard spurious eigenpairs */
 57:   PetscBool    isreal;     /* A and B are real */
 58:   PetscInt     refine_inner;
 59:   PetscInt     refine_outer;
 60:   PetscInt     refine_blocksize;
 61:   /* private data */
 62:   PetscReal    *sigma;     /* threshold for numerical rank */
 63:   PetscInt     num_subcomm;
 64:   PetscInt     subcomm_id;
 65:   PetscInt     num_solve_point;
 66:   PetscScalar  *weight;
 67:   PetscScalar  *omega;
 68:   PetscScalar  *pp;
 69:   BV           V;
 70:   BV           S;
 71:   BV           Y;
 72:   KSP          *ksp;
 73:   Mat          *kspMat;
 74:   PetscBool    useconj;
 75:   PetscReal    est_eig;
 76:   PetscSubcomm subcomm;
 77:   PetscBool    usest;
 78: } NEP_CISS;

 82: static PetscErrorCode SetSolverComm(NEP nep)
 83: {
 85:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
 86:   PetscInt       N = ctx->N;

 89:   if (ctx->useconj) N = N/2;
 90:   if (!ctx->subcomm) {
 91:     PetscSubcommCreate(PetscObjectComm((PetscObject)nep),&ctx->subcomm);
 92:     PetscSubcommSetNumber(ctx->subcomm,ctx->num_subcomm);
 93:     PetscSubcommSetType(ctx->subcomm,PETSC_SUBCOMM_INTERLACED);
 94:     PetscLogObjectMemory((PetscObject)nep,sizeof(PetscSubcomm));
 95:     PetscSubcommSetFromOptions(ctx->subcomm);
 96:   }
 97:   ctx->subcomm_id = ctx->subcomm->color;
 98:   ctx->num_solve_point = N / ctx->num_subcomm;
 99:   if ((N%ctx->num_subcomm) > ctx->subcomm_id) ctx->num_solve_point+=1;
100:   return(0);
101: }

105: static PetscErrorCode SetPathParameter(NEP nep)
106: {
108:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
109:   PetscInt       i;
110:   PetscScalar    center;
111:   PetscReal      theta,radius,vscale;
112:   PetscBool      isellipse=PETSC_FALSE;

115:   PetscObjectTypeCompare((PetscObject)nep->rg,RGELLIPSE,&isellipse);
116:   if (isellipse) {
117:     RGEllipseGetParameters(nep->rg,&center,&radius,&vscale);
118:   } else SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"Region must be Ellipse");
119:   for (i=0;i<ctx->N;i++) {
120:     theta = ((2*PETSC_PI)/ctx->N)*(i+0.5);
121:     ctx->pp[i] = PetscCosReal(theta) + PETSC_i*vscale*PetscSinReal(theta);
122:     ctx->weight[i] = radius*(vscale*PetscCosReal(theta) + PETSC_i*PetscSinReal(theta))/(PetscReal)ctx->N;
123:     ctx->omega[i] = center + radius*ctx->pp[i];
124:   }
125:   return(0);
126: }

130: static PetscErrorCode CISSVecSetRandom(BV V,PetscInt i0,PetscInt i1,PetscRandom rctx)
131: {
133:   PetscInt       i,j,nlocal;
134:   PetscScalar    *vdata;
135:   Vec            x;

138:   BVGetSizes(V,&nlocal,NULL,NULL);
139:   for (i=i0;i<i1;i++) {
140:     BVSetRandomColumn(V,i,rctx);
141:     BVGetColumn(V,i,&x);
142:     VecGetArray(x,&vdata);
143:     for (j=0;j<nlocal;j++) {
144:       vdata[j] = PetscRealPart(vdata[j]);
145:       if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
146:       else vdata[j] = 1.0;
147:     }
148:     VecRestoreArray(x,&vdata);
149:     BVRestoreColumn(V,i,&x);
150:   }
151:   return(0);
152: }

156: static PetscErrorCode SolveLinearSystem(NEP nep,Mat T,Mat dT,BV V,PetscInt L_start,PetscInt L_end,PetscBool initksp)
157: {
159:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
160:   PetscInt       i,j,p_id;
161:   Mat            Fz;
162:   PC             pc;
163:   Vec            Bvj,vj,yj;
164:   KSP            ksp;

167:   if (ctx->usest) {
168:     NEPComputeFunction(nep,0,T,T);
169:     MatDuplicate(T,MAT_DO_NOT_COPY_VALUES,&Fz);
170:     KSPCreate(PetscObjectComm((PetscObject)nep),&ksp);
171:   }
172:   BVCreateVec(V,&Bvj);
173:   for (i=0;i<ctx->num_solve_point;i++) {
174:     p_id = i*ctx->subcomm->n + ctx->subcomm_id;
175:     NEPComputeFunction(nep,ctx->omega[p_id],T,T);
176:     NEPComputeJacobian(nep,ctx->omega[p_id],dT);
177:     if (!ctx->usest && initksp == PETSC_TRUE) {
178:       MatDuplicate(T,MAT_COPY_VALUES,&ctx->kspMat[i]);
179:       KSPSetOperators(ctx->ksp[i],ctx->kspMat[i],ctx->kspMat[i]);
180:       KSPSetType(ctx->ksp[i],KSPPREONLY);
181:       KSPGetPC(ctx->ksp[i],&pc);
182:       PCSetType(pc,PCREDUNDANT);
183:       KSPSetFromOptions(ctx->ksp[i]);
184:     } else if (ctx->usest) {
185:       MatCopy(T,Fz,DIFFERENT_NONZERO_PATTERN);
186:       KSPSetOperators(ksp,Fz,Fz);
187:       KSPSetType(ksp,KSPPREONLY);
188:       KSPGetPC(ksp,&pc);
189:       PCSetType(pc,PCREDUNDANT);
190:       KSPSetFromOptions(ksp);
191:     }
192:     for (j=L_start;j<L_end;j++) {
193:       BVGetColumn(V,j,&vj);
194:       BVGetColumn(ctx->Y,i*ctx->L_max+j,&yj);
195:       MatMult(dT,vj,Bvj);
196:       if (ctx->usest) {
197:         KSPSolve(ksp,Bvj,yj);
198:       } else {
199:         KSPSolve(ctx->ksp[i],Bvj,yj);
200:       }
201:       BVRestoreColumn(V,j,&vj);
202:       BVRestoreColumn(ctx->Y,i*ctx->L_max+j,&yj);
203:     }
204:     if (ctx->usest && i<ctx->num_solve_point-1) {  KSPReset(ksp); }
205:   }
206:   if (ctx->usest) {
207:     MatDestroy(&Fz);
208:     KSPDestroy(&ksp);
209:   }
210:   VecDestroy(&Bvj);
211:   return(0);
212: }

216: static PetscErrorCode EstimateNumberEigs(NEP nep,PetscInt *L_add)
217: {
219:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
220:   PetscInt       i,j,p_id;
221:   PetscScalar    tmp,m = 1,sum = 0.0;
222:   PetscReal      eta;
223:   Vec            v,vtemp,vj,yj;

226:   BVGetColumn(ctx->Y,0,&yj);
227:   VecDuplicate(yj,&v);
228:   BVRestoreColumn(ctx->Y,0,&yj);
229:   BVCreateVec(ctx->V,&vtemp);
230:   for (j=0;j<ctx->L;j++) {
231:     VecSet(v,0);
232:     for (i=0;i<ctx->num_solve_point; i++) {
233:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
234:       BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
235:       BVMultVec(ctx->Y,ctx->weight[p_id],1,v,&m);
236:     }
237:     BVGetColumn(ctx->V,j,&vj);
238:     VecDot(vj,v,&tmp);
239:     BVRestoreColumn(ctx->V,j,&vj);
240:     if (ctx->useconj) sum += PetscRealPart(tmp)*2;
241:     else sum += tmp;
242:   }
243:   ctx->est_eig = PetscAbsScalar(sum/(PetscReal)ctx->L);
244:   eta = PetscPowReal(10,-PetscLog10Real(nep->rtol)/ctx->N);
245:   PetscInfo1(nep,"Estimation_#Eig %f\n",(double)ctx->est_eig);
246:   *L_add = (PetscInt)PetscCeilReal((ctx->est_eig*eta)/ctx->M) - ctx->L;
247:   if (*L_add < 0) *L_add = 0;
248:   if (*L_add>ctx->L_max-ctx->L) {
249:     PetscInfo(nep,"Number of eigenvalues around the contour path may be too large\n");
250:     *L_add = ctx->L_max-ctx->L;
251:   }
252:   VecDestroy(&v);
253:   VecDestroy(&vtemp);
254:   return(0);
255: }

259: static PetscErrorCode CalcMu(NEP nep, PetscScalar *Mu)
260: {
262:   PetscMPIInt    sub_size;
263:   PetscInt       i,j,k,s;
264:   PetscScalar    *m,*temp,*temp2,*ppk,alp;
265:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
266:   Mat            M;

269:   MPI_Comm_size(PetscSubcommChild(ctx->subcomm),&sub_size);
270:   PetscMalloc3(ctx->num_solve_point*ctx->L*(ctx->L+1),&temp,2*ctx->M*ctx->L*ctx->L,&temp2,ctx->num_solve_point,&ppk);
271:   MatCreateSeqDense(PETSC_COMM_SELF,ctx->L,ctx->L_max*ctx->num_solve_point,NULL,&M);
272:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
273:   BVSetActiveColumns(ctx->Y,0,ctx->L_max*ctx->num_solve_point);
274:   BVSetActiveColumns(ctx->V,0,ctx->L);
275:   BVDot(ctx->Y,ctx->V,M);
276:   MatDenseGetArray(M,&m);
277:   for (i=0;i<ctx->num_solve_point;i++) {
278:     for (j=0;j<ctx->L;j++) {
279:       for (k=0;k<ctx->L;k++) {
280:         temp[k+j*ctx->L+i*ctx->L*ctx->L]=m[k+j*ctx->L+i*ctx->L*ctx->L_max];
281:       }
282:     }
283:   }
284:   MatDenseRestoreArray(M,&m);
285:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
286:   for (k=0;k<2*ctx->M;k++) {
287:     for (j=0;j<ctx->L;j++) {
288:       for (i=0;i<ctx->num_solve_point;i++) {
289:         alp = ppk[i]*ctx->weight[i*ctx->subcomm->n + ctx->subcomm_id];
290:         for (s=0;s<ctx->L;s++) {
291:           if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
292:           else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
293:         }
294:       }
295:     }
296:     for (i=0;i<ctx->num_solve_point;i++) 
297:       ppk[i] *= ctx->pp[i*ctx->subcomm->n + ctx->subcomm_id];
298:   }
299:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] /= sub_size;
300:   MPI_Allreduce(temp2,Mu,2*ctx->M*ctx->L*ctx->L,MPIU_SCALAR,MPIU_SUM,(PetscObjectComm((PetscObject)nep)));
301:   PetscFree3(temp,temp2,ppk);
302:   MatDestroy(&M);
303:   return(0);
304: }

308: static PetscErrorCode BlockHankel(NEP nep,PetscScalar *Mu,PetscInt s,PetscScalar *H)
309: {
310:   NEP_CISS *ctx = (NEP_CISS*)nep->data;
311:   PetscInt  i,j,k,L=ctx->L,M=ctx->M;

314:   for (k=0;k<L*M;k++)
315:     for (j=0;j<M;j++) 
316:       for (i=0;i<L;i++) 
317:         H[j*L+i+k*L*M] = Mu[i+k*L+(j+s)*L*L];
318:   return(0);
319: }

323: static PetscErrorCode SVD_H0(NEP nep,PetscScalar *S,PetscInt *K)
324: {
325: #if defined(SLEPC_MISSING_LAPACK_GESVD)
327:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
328: #else
330:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
331:   PetscInt       i,ml=ctx->L*ctx->M;
332:   PetscBLASInt   m,n,lda,ldu,ldvt,lwork,info;
333:   PetscScalar    *work;
334: #if defined(PETSC_USE_COMPLEX)
335:   PetscReal      *rwork;
336: #endif

339:   PetscMalloc1(5*ml,&work);
340: #if defined(PETSC_USE_COMPLEX)
341:   PetscMalloc1(5*ml,&rwork);
342: #endif
343:   PetscBLASIntCast(ml,&m);
344:   n = m; lda = m; ldu = m; ldvt = m; lwork = 5*m;
345:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);
346: #if defined(PETSC_USE_COMPLEX)
347:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
348: #else
349:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
350: #endif
351:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
352:   PetscFPTrapPop();
353:   (*K) = 0;
354:   for (i=0;i<ml;i++) {
355:     if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
356:   }
357:   PetscFree(work);
358: #if defined(PETSC_USE_COMPLEX)
359:   PetscFree(rwork);
360: #endif
361:   return(0);
362: #endif
363: }

367: static PetscErrorCode ConstructS(NEP nep)
368: {
370:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
371:   PetscInt       i,j,k,vec_local_size,p_id;
372:   Vec            v,sj,yj;
373:   PetscScalar    *ppk, *v_data, m = 1;

376:   BVGetSizes(ctx->Y,&vec_local_size,NULL,NULL);
377:   PetscMalloc1(ctx->num_solve_point,&ppk);
378:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
379:   BVGetColumn(ctx->Y,0,&yj);
380:   VecDuplicate(yj,&v);
381:   BVRestoreColumn(ctx->Y,0,&yj);
382:   for (k=0;k<ctx->M;k++) {
383:     for (j=0;j<ctx->L;j++) {
384:       VecSet(v,0);
385:       for (i=0;i<ctx->num_solve_point;i++) {
386:         p_id = i*ctx->subcomm->n + ctx->subcomm_id;
387:         BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
388:         BVMultVec(ctx->Y,ppk[i]*ctx->weight[p_id],1,v,&m);
389:       }
390:       if (ctx->useconj) {
391:         VecGetArray(v,&v_data);
392:         for (i=0;i<vec_local_size;i++) v_data[i] = PetscRealPart(v_data[i])*2;
393:         VecRestoreArray(v,&v_data);
394:       }
395:       BVGetColumn(ctx->S,k*ctx->L+j,&sj);
396:       VecCopy(v,sj);
397:       BVRestoreColumn(ctx->S,k*ctx->L+j,&sj);
398:     }
399:     for (i=0;i<ctx->num_solve_point;i++) {
400:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
401:       ppk[i] *= ctx->pp[p_id];
402:     }
403:   }
404:   PetscFree(ppk);
405:   VecDestroy(&v);
406:   return(0);
407: }

411: static PetscErrorCode isGhost(NEP nep,PetscInt ld,PetscInt nv,PetscBool *fl)
412: {
414:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
415:   PetscInt       i,j;
416:   PetscScalar    *pX;
417:   PetscReal      *tau,s1,s2,tau_max=0.0;

420:   PetscMalloc1(nv,&tau);
421:   DSVectors(nep->ds,DS_MAT_X,NULL,NULL);
422:   DSGetArray(nep->ds,DS_MAT_X,&pX);

424:   for (i=0;i<nv;i++) {
425:     s1 = 0;
426:     s2 = 0;
427:     for (j=0;j<nv;j++) {
428:       s1 += PetscAbsScalar(PetscPowScalar(pX[i*ld+j],2));
429:       s2 += PetscPowReal(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
430:     }
431:     tau[i] = s1/s2;
432:     tau_max = PetscMax(tau_max,tau[i]);
433:   }
434:   DSRestoreArray(nep->ds,DS_MAT_X,&pX);
435:   for (i=0;i<nv;i++) {
436:     tau[i] /= tau_max;
437:   }
438:   for (i=0;i<nv;i++) {
439:     if (tau[i]>=ctx->spurious_threshold) fl[i] = PETSC_TRUE;
440:     else fl[i] = PETSC_FALSE;
441:   }
442:   PetscFree(tau);
443:   return(0);
444: }

448: PetscErrorCode NEPSetUp_CISS(NEP nep)
449: {
451:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
452:   const char     *prefix;
453:   PetscInt       i;
454:   PetscBool      istrivial,isellipse;
455:   PetscScalar    center;

458:   nep->ncv = PetscMin(nep->n,ctx->L*ctx->M);
459:   if (!nep->mpd) nep->mpd = nep->ncv;
460:   if (!nep->which) nep->which = NEP_LARGEST_MAGNITUDE;

462:   /* check region */
463:   RGIsTrivial(nep->rg,&istrivial);
464:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"NEPCISS requires a nontrivial region, e.g. -rg_type ellipse ...");
465:   PetscObjectTypeCompare((PetscObject)nep->rg,RGELLIPSE,&isellipse);
466:   if (!isellipse) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"Currently only implemented for elliptic or arc regions");
467:   RGEllipseGetParameters(nep->rg,&center,NULL,NULL);
468:   if (ctx->isreal && PetscImaginaryPart(center) == 0.0) ctx->useconj = PETSC_TRUE;
469:   else ctx->useconj = PETSC_FALSE;

471:   /* create split comm */
472:   ctx->num_subcomm = 1;
473:   SetSolverComm(nep);

475:   NEPAllocateSolution(nep,0);
476:   PetscMalloc4(ctx->N,&ctx->weight,ctx->N,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
477:   PetscLogObjectMemory((PetscObject)nep,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));

479:   /* allocate basis vectors */
480:   BVDuplicateResize(nep->V,ctx->L_max*ctx->M,&ctx->S);
481:   PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->S);
482:   BVDuplicateResize(nep->V,ctx->L_max,&ctx->V);
483:   PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->V);

485:   if (!ctx->usest) {
486:     PetscMalloc2(ctx->num_solve_point,&ctx->ksp,ctx->num_solve_point,&ctx->kspMat);
487:     PetscLogObjectMemory((PetscObject)nep,ctx->num_solve_point*sizeof(KSP)+ctx->num_solve_point*sizeof(Mat));
488:     for (i=0;i<ctx->num_solve_point;i++) {
489:       KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
490:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)nep,1);
491:       PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->ksp[i]);
492:       KSPAppendOptionsPrefix(ctx->ksp[i],"nep_ciss_");
493:       NEPGetOptionsPrefix(nep,&prefix);
494:       KSPAppendOptionsPrefix(ctx->ksp[i],prefix);
495:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
496:     }
497:   }

499:   BVDuplicateResize(nep->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);

501:   DSSetType(nep->ds,DSGNHEP);
502:   DSAllocate(nep->ds,nep->ncv);
503:   NEPSetWorkVecs(nep,2);

505:   /* dispatch solve method */
506:   nep->ops->solve = NEPSolve_CISS;
507:   return(0);
508: }

512: PetscErrorCode NEPSolve_CISS(NEP nep)
513: {
515:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
516:   Mat            X,M;
517:   PetscInt       i,j,ld,L_add=0,nv=0,L_base=ctx->L,inner,outer,nlocal,*inside;
518:   PetscScalar    *Mu,*H0,*H1,*rr,*temp,center;
519:   PetscReal      error,max_error,radius;
520:   PetscBool      *fl1;
521:   Vec            si,w[3];
522:   SlepcSC        sc;

525:   w[0] = nep->work[0];
526:   w[1] = NULL;
527:   w[2] = nep->work[1];
528:   DSGetSlepcSC(nep->ds,&sc);
529:   sc->comparison    = SlepcCompareLargestMagnitude;
530:   sc->comparisonctx = NULL;
531:   sc->map           = NULL;
532:   sc->mapobj        = NULL;
533:   VecGetLocalSize(w[0],&nlocal);
534:   DSGetLeadingDimension(nep->ds,&ld);
535:   SetPathParameter(nep);
536:   CISSVecSetRandom(ctx->V,0,ctx->L,nep->rand);

538:   SolveLinearSystem(nep,nep->function,nep->jacobian,ctx->V,0,ctx->L,PETSC_TRUE);
539:   EstimateNumberEigs(nep,&L_add);
540:   if (L_add>0) {
541:     PetscInfo2(nep,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
542:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,nep->rand);
543:     SolveLinearSystem(nep,nep->function,nep->jacobian,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
544:     ctx->L += L_add;
545:   }
546:   PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
547:   for (i=0;i<ctx->refine_blocksize;i++) {
548:     CalcMu(nep,Mu);
549:     BlockHankel(nep,Mu,0,H0);
550:     SVD_H0(nep,H0,&nv);
551:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
552:     L_add = L_base;
553:     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
554:     PetscInfo2(nep,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
555:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,nep->rand);
556:     SolveLinearSystem(nep,nep->function,nep->jacobian,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
557:     ctx->L += L_add;
558:   }
559:   PetscFree2(Mu,H0);

561:   PetscMalloc3(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0,ctx->L*ctx->M*ctx->L*ctx->M,&H1);
562:   for (outer=0;outer<=ctx->refine_outer;outer++) {
563:     for (inner=0;inner<=ctx->refine_inner;inner++) {
564:       CalcMu(nep,Mu);
565:       BlockHankel(nep,Mu,0,H0);
566:       SVD_H0(nep,H0,&nv);
567:       if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
568:         ConstructS(nep);
569:         BVSetActiveColumns(ctx->S,0,ctx->L);
570:         BVCopy(ctx->S,ctx->V);
571:         SolveLinearSystem(nep,nep->function,nep->jacobian,ctx->V,0,ctx->L,PETSC_FALSE);
572:       } else break;
573:     }

575:     nep->nconv = 0;
576:     if (nv == 0) break;
577:     BlockHankel(nep,Mu,0,H0);
578:     BlockHankel(nep,Mu,1,H1);
579:     DSSetDimensions(nep->ds,nv,0,0,0);
580:     DSSetState(nep->ds,DS_STATE_RAW);
581:     DSGetArray(nep->ds,DS_MAT_A,&temp);
582:     for (j=0;j<nv;j++)
583:       for (i=0;i<nv;i++)
584:         temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
585:     DSRestoreArray(nep->ds,DS_MAT_A,&temp);
586:     DSGetArray(nep->ds,DS_MAT_B,&temp);
587:     for (j=0;j<nv;j++) 
588:       for (i=0;i<nv;i++)
589:         temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
590:     DSRestoreArray(nep->ds,DS_MAT_B,&temp);
591:     DSSolve(nep->ds,nep->eigr,nep->eigi);
592:     DSVectors(nep->ds,DS_MAT_X,NULL,NULL);
593:     RGEllipseGetParameters(nep->rg,&center,&radius,NULL);
594:     for (i=0;i<nv;i++){
595:       nep->eigr[i] = nep->eigr[i]*radius+center;
596: #if !defined(PETSC_USE_COMPLEX)
597:       nep->eigi[i] = nep->eigi[i]*radius;
598: #endif
599:     }
600:     PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
601:     isGhost(nep,ld,nv,fl1);
602:     RGCheckInside(nep->rg,nv,nep->eigr,nep->eigi,inside);
603:     for (i=0;i<nv;i++) {
604:       if (fl1[i] && inside[i]>0) {
605:         rr[i] = 1.0;
606:         nep->nconv++;
607:       } else rr[i] = 0.0;
608:     }
609:     DSSort(nep->ds,nep->eigr,nep->eigi,rr,NULL,&nep->nconv);
610:     for (i=0;i<nv;i++){
611:       nep->eigr[i] = nep->eigr[i]*radius+center;
612: #if !defined(PETSC_USE_COMPLEX)
613:       nep->eigi[i] = nep->eigi[i]*radius;
614: #endif
615:     }
616:     PetscFree3(fl1,inside,rr);
617:     BVSetActiveColumns(nep->V,0,nv);
618:     ConstructS(nep);
619:     BVSetActiveColumns(ctx->S,0,nv);
620:     BVCopy(ctx->S,nep->V);

622:     DSVectors(nep->ds,DS_MAT_X,NULL,NULL);
623:     DSGetMat(nep->ds,DS_MAT_X,&X);
624:     BVMultInPlace(ctx->S,X,0,nep->nconv);
625:     BVMultInPlace(nep->V,X,0,nep->nconv);
626:     MatDestroy(&X);
627:     max_error = 0.0;
628:     for (i=0;i<nep->nconv;i++) {
629:       BVGetColumn(nep->V,i,&si);
630:       VecNormalize(si,NULL);
631:       NEPComputeResidualNorm_Private(nep,nep->eigr[i],si,w,&error);
632:       BVRestoreColumn(nep->V,i,&si);
633:       max_error = PetscMax(max_error,error);
634:     }
635:     if (max_error <= nep->rtol || outer == ctx->refine_outer) break;

637:     if (nep->nconv > ctx->L) nv = nep->nconv;
638:     else if (ctx->L > nv) nv = ctx->L;
639:     MatCreateSeqDense(PETSC_COMM_SELF,nv,ctx->L,NULL,&M);
640:     MatDenseGetArray(M,&temp);
641:     for (i=0;i<ctx->L*nv;i++) {
642:       PetscRandomGetValue(nep->rand,&temp[i]);
643:       temp[i] = PetscRealPart(temp[i]);
644:     }
645:     MatDenseRestoreArray(M,&temp);
646:     BVSetActiveColumns(ctx->S,0,nv);
647:     BVMultInPlace(ctx->S,M,0,ctx->L);
648:     MatDestroy(&M);
649:     BVSetActiveColumns(ctx->S,0,ctx->L);
650:     BVCopy(ctx->S,ctx->V);
651:     SolveLinearSystem(nep,nep->function,nep->jacobian,ctx->V,0,ctx->L,PETSC_FALSE);
652:   }
653:   PetscFree3(Mu,H0,H1);  
654:   nep->reason = NEP_CONVERGED_FNORM_RELATIVE;
655:   return(0);
656: }

660: static PetscErrorCode NEPCISSSetSizes_CISS(NEP nep,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
661: {
662:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

665:   if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
666:     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
667:   } else {
668:     if (ip<1) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
669:     if (ip%2) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
670:     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
671:   }
672:   if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
673:     ctx->L = 16;
674:   } else {
675:     if (bs<1) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
676:     if (bs>ctx->L_max) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be less than or equal to the maximum number of block size");
677:     ctx->L = bs;
678:   }
679:   if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
680:     ctx->M = ctx->N/4;
681:   } else {
682:     if (ms<1) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
683:     if (ms>ctx->N) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be less than or equal to the number of integration points");
684:     ctx->M = ms;
685:   }
686:   if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
687:     ctx->num_subcomm = 1;
688:   } else {
689:     if (npart<1) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
690:     ctx->num_subcomm = npart;
691:   }
692:   if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
693:     ctx->L = 256;
694:   } else {
695:     if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
696:     if (bsmax<ctx->L) ctx->L_max = ctx->L;
697:     else ctx->L_max = bsmax;
698:   }
699:   ctx->isreal = isreal;
700:   return(0);
701: }

705: /*@
706:    NEPCISSSetSizes - Sets the values of various size parameters in the CISS solver.

708:    Logically Collective on NEP

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

719:    Options Database Keys:
720: +  -nep_ciss_integration_points - Sets the number of integration points
721: .  -nep_ciss_blocksize - Sets the block size
722: .  -nep_ciss_moments - Sets the moment size
723: .  -nep_ciss_partitions - Sets the number of partitions
724: .  -nep_ciss_maxblocksize - Sets the maximum block size
725: -  -nep_ciss_realmats - A and B are real

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

732:    Level: advanced

734: .seealso: NEPCISSGetSizes()
735: @*/
736: PetscErrorCode NEPCISSSetSizes(NEP nep,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
737: {

748:   PetscTryMethod(nep,"NEPCISSSetSizes_C",(NEP,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(nep,ip,bs,ms,npart,bsmax,isreal));
749:   return(0);
750: }

754: static PetscErrorCode NEPCISSGetSizes_CISS(NEP nep,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
755: {
756:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

759:   if (ip) *ip = ctx->N;
760:   if (bs) *bs = ctx->L;
761:   if (ms) *ms = ctx->M;
762:   if (npart) *npart = ctx->num_subcomm;
763:   if (bsmax) *bsmax = ctx->L_max;
764:   if (isreal) *isreal = ctx->isreal;
765:   return(0);
766: }

770: /*@
771:    NEPCISSGetSizes - Gets the values of various size parameters in the CISS solver.

773:    Not Collective

775:    Input Parameter:
776: .  nep - the eigenproblem solver context

778:    Output Parameters:
779: +  ip    - number of integration points
780: .  bs    - block size
781: .  ms    - moment size
782: .  npart - number of partitions when splitting the communicator
783: .  bsmax - max block size
784: -  isreal - A and B are real

786:    Level: advanced

788: .seealso: NEPCISSSetSizes()
789: @*/
790: PetscErrorCode NEPCISSGetSizes(NEP nep,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
791: {

796:   PetscTryMethod(nep,"NEPCISSGetSizes_C",(NEP,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(nep,ip,bs,ms,npart,bsmax,isreal));
797:   return(0);
798: }

802: static PetscErrorCode NEPCISSSetThreshold_CISS(NEP nep,PetscReal delta,PetscReal spur)
803: {
804:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

807:   if (delta == PETSC_DEFAULT) {
808:     ctx->delta = 1e-12;
809:   } else {
810:     if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
811:     ctx->delta = delta;
812:   }
813:   if (spur == PETSC_DEFAULT) {
814:     ctx->spurious_threshold = 1e-4;
815:   } else {
816:     if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
817:     ctx->spurious_threshold = spur;
818:   }
819:   return(0);
820: }

824: /*@
825:    NEPCISSSetThreshold - Sets the values of various threshold parameters in
826:    the CISS solver.

828:    Logically Collective on NEP

830:    Input Parameters:
831: +  nep   - the eigenproblem solver context
832: .  delta - threshold for numerical rank
833: -  spur  - spurious threshold (to discard spurious eigenpairs)

835:    Options Database Keys:
836: +  -nep_ciss_delta - Sets the delta
837: -  -nep_ciss_spurious_threshold - Sets the spurious threshold

839:    Level: advanced

841: .seealso: NEPCISSGetThreshold()
842: @*/
843: PetscErrorCode NEPCISSSetThreshold(NEP nep,PetscReal delta,PetscReal spur)
844: {

851:   PetscTryMethod(nep,"NEPCISSSetThreshold_C",(NEP,PetscReal,PetscReal),(nep,delta,spur));
852:   return(0);
853: }

857: static PetscErrorCode NEPCISSGetThreshold_CISS(NEP nep,PetscReal *delta,PetscReal *spur)
858: {
859:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

862:   if (delta) *delta = ctx->delta;
863:   if (spur)  *spur = ctx->spurious_threshold;
864:   return(0);
865: }

869: /*@
870:    NEPCISSGetThreshold - Gets the values of various threshold parameters in
871:    the CISS solver.

873:    Not Collective

875:    Input Parameter:
876: .  nep - the eigenproblem solver context

878:    Output Parameters:
879: +  delta - threshold for numerical rank
880: -  spur  - spurious threshold (to discard spurious eigenpairs)

882:    Level: advanced

884: .seealso: NEPCISSSetThreshold()
885: @*/
886: PetscErrorCode NEPCISSGetThreshold(NEP nep,PetscReal *delta,PetscReal *spur)
887: {

892:   PetscTryMethod(nep,"NEPCISSGetThreshold_C",(NEP,PetscReal*,PetscReal*),(nep,delta,spur));
893:   return(0);
894: }

898: static PetscErrorCode NEPCISSSetRefinement_CISS(NEP nep,PetscInt inner,PetscInt outer,PetscInt blsize)
899: {
900:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

903:   if (inner == PETSC_DEFAULT) {
904:     ctx->refine_inner = 0;
905:   } else {
906:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
907:     ctx->refine_inner = inner;
908:   }
909:   if (outer == PETSC_DEFAULT) {
910:     ctx->refine_outer = 0;
911:   } else {
912:     if (outer<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The refine outer argument must be >= 0");
913:     ctx->refine_outer = outer;
914:   }
915:   if (blsize == PETSC_DEFAULT) {
916:     ctx->refine_blocksize = 0;
917:   } else {
918:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
919:     ctx->refine_blocksize = blsize;
920:   }
921:   return(0);
922: }

926: /*@
927:    NEPCISSSetRefinement - Sets the values of various refinement parameters
928:    in the CISS solver.

930:    Logically Collective on NEP

932:    Input Parameters:
933: +  nep    - the eigenproblem solver context
934: .  inner  - number of iterative refinement iterations (inner loop)
935: .  outer  - number of iterative refinement iterations (outer loop)
936: -  blsize - number of iterative refinement iterations (blocksize loop)

938:    Options Database Keys:
939: +  -nep_ciss_refine_inner - Sets number of inner iterations
940: .  -nep_ciss_refine_outer - Sets number of outer iterations
941: -  -nep_ciss_refine_blocksize - Sets number of blocksize iterations

943:    Level: advanced

945: .seealso: NEPCISSGetRefinement()
946: @*/
947: PetscErrorCode NEPCISSSetRefinement(NEP nep,PetscInt inner,PetscInt outer,PetscInt blsize)
948: {

956:   PetscTryMethod(nep,"NEPCISSSetRefinement_C",(NEP,PetscInt,PetscInt,PetscInt),(nep,inner,outer,blsize));
957:   return(0);
958: }

962: static PetscErrorCode NEPCISSGetRefinement_CISS(NEP nep,PetscInt *inner,PetscInt *outer,PetscInt *blsize)
963: {
964:   NEP_CISS *ctx = (NEP_CISS*)nep->data;

967:   if (inner)  *inner = ctx->refine_inner;
968:   if (outer)  *outer = ctx->refine_outer;
969:   if (blsize) *blsize = ctx->refine_blocksize;
970:   return(0);
971: }

975: /*@
976:    NEPCISSGetRefinement - Gets the values of various refinement parameters
977:    in the CISS solver.

979:    Not Collective

981:    Input Parameter:
982: .  nep - the eigenproblem solver context

984:    Output Parameters:
985: +  inner  - number of iterative refinement iterations (inner loop)
986: .  outer  - number of iterative refinement iterations (outer loop)
987: -  blsize - number of iterative refinement iterations (blocksize loop)

989:    Level: advanced

991: .seealso: NEPCISSSetRefinement()
992: @*/
993: PetscErrorCode NEPCISSGetRefinement(NEP nep, PetscInt *inner, PetscInt *outer,PetscInt *blsize)
994: {

999:   PetscTryMethod(nep,"NEPCISSGetRefinement_C",(NEP,PetscInt*,PetscInt*,PetscInt*),(nep,inner,outer,blsize));
1000:   return(0);
1001: }

1005: PetscErrorCode NEPReset_CISS(NEP nep)
1006: {
1008:   PetscInt       i;
1009:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;

1012:   PetscSubcommDestroy(&ctx->subcomm);
1013:   PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
1014:   BVDestroy(&ctx->S);
1015:   BVDestroy(&ctx->V);
1016:   BVDestroy(&ctx->Y);
1017:   if (!ctx->usest) {
1018:     for (i=0;i<ctx->num_solve_point;i++) {
1019:       KSPDestroy(&ctx->ksp[i]);
1020:     }
1021:     for (i=0;i<ctx->num_solve_point;i++) {
1022:       MatDestroy(&ctx->kspMat[i]);
1023:     }
1024:     PetscFree2(ctx->ksp,ctx->kspMat);
1025:   }
1026:   return(0);
1027: }

1031: PetscErrorCode NEPSetFromOptions_CISS(PetscOptions *PetscOptionsObject,NEP nep)
1032: {
1034:   PetscReal      r1,r2;
1035:   PetscInt       i1,i2,i3,i4,i5,i6,i7,i8;
1036:   PetscBool      b1;

1039:   PetscOptionsHead(PetscOptionsObject,"NEP CISS Options");

1041:   NEPCISSGetSizes(nep,&i1,&i2,&i3,&i4,&i5,&b1);
1042:   PetscOptionsInt("-nep_ciss_integration_points","CISS number of integration points","NEPCISSSetSizes",i1,&i1,NULL);
1043:   PetscOptionsInt("-nep_ciss_blocksize","CISS block size","NEPCISSSetSizes",i2,&i2,NULL);
1044:   PetscOptionsInt("-nep_ciss_moments","CISS moment size","NEPCISSSetSizes",i3,&i3,NULL);
1045:   PetscOptionsInt("-nep_ciss_partitions","CISS number of partitions","NEPCISSSetSizes",i4,&i4,NULL);
1046:   PetscOptionsInt("-nep_ciss_maxblocksize","CISS maximum block size","NEPCISSSetSizes",i5,&i5,NULL);
1047:   PetscOptionsBool("-nep_ciss_realmats","CISS A and B are real","NEPCISSSetSizes",b1,&b1,NULL);
1048:   NEPCISSSetSizes(nep,i1,i2,i3,i4,i5,b1);

1050:   NEPCISSGetThreshold(nep,&r1,&r2);
1051:   PetscOptionsReal("-nep_ciss_delta","CISS threshold for numerical rank","NEPCISSSetThreshold",r1,&r1,NULL);
1052:   PetscOptionsReal("-nep_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","NEPCISSSetThreshold",r2,&r2,NULL);
1053:   NEPCISSSetThreshold(nep,r1,r2);
1054:   PetscOptionsTail();

1056:   NEPCISSGetRefinement(nep,&i6,&i7,&i8);
1057:   PetscOptionsInt("-nep_ciss_refine_inner","CISS number of inner iterative refinement iterations","NEPCISSSetRefinement",i6,&i6,NULL);
1058:   PetscOptionsInt("-nep_ciss_refine_outer","CISS number of outer iterative refinement iterations","NEPCISSSetRefinement",i7,&i7,NULL);
1059:   PetscOptionsInt("-nep_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","NEPCISSSetRefinement",i8,&i8,NULL);
1060:   NEPCISSSetRefinement(nep,i6,i7,i8);

1062:   return(0);
1063: }

1067: PetscErrorCode NEPDestroy_CISS(NEP nep)
1068: {

1072:   PetscFree(nep->data);
1073:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetSizes_C",NULL);
1074:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetSizes_C",NULL);
1075:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetThreshold_C",NULL);
1076:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetThreshold_C",NULL);
1077:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetRefinement_C",NULL);
1078:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetRefinement_C",NULL);
1079:   return(0);
1080: }

1084: PetscErrorCode NEPView_CISS(NEP nep,PetscViewer viewer)
1085: {
1087:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;
1088:   PetscBool      isascii;

1091:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1092:   if (isascii) {
1093:     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);
1094:     if (ctx->isreal) {
1095:       PetscViewerASCIIPrintf(viewer,"  CISS: exploiting symmetry of integration points\n");
1096:     }
1097:     PetscViewerASCIIPrintf(viewer,"  CISS: threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
1098:     PetscViewerASCIIPrintf(viewer,"  CISS: iterative refinement  { inner: %D, outer: %D, blocksize: %D }\n",ctx->refine_inner,ctx->refine_outer, ctx->refine_blocksize);
1099:     PetscViewerASCIIPushTab(viewer);
1100:     /*KSPView(ctx->ksp[0],viewer);*/
1101:     PetscViewerASCIIPopTab(viewer);
1102:   }
1103:   return(0);
1104: }

1108: PETSC_EXTERN PetscErrorCode NEPCreate_CISS(NEP nep)
1109: {
1111:   NEP_CISS       *ctx = (NEP_CISS*)nep->data;

1114:   PetscNewLog(nep,&ctx);
1115:   nep->data = ctx;
1116:   nep->ops->solve          = NEPSolve_CISS;
1117:   nep->ops->setup          = NEPSetUp_CISS;
1118:   nep->ops->setfromoptions = NEPSetFromOptions_CISS;
1119:   nep->ops->reset          = NEPReset_CISS;
1120:   nep->ops->destroy        = NEPDestroy_CISS;
1121:   nep->ops->view           = NEPView_CISS;
1122:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetSizes_C",NEPCISSSetSizes_CISS);
1123:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetSizes_C",NEPCISSGetSizes_CISS);
1124:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetThreshold_C",NEPCISSSetThreshold_CISS);
1125:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetThreshold_C",NEPCISSGetThreshold_CISS);
1126:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSSetRefinement_C",NEPCISSSetRefinement_CISS);
1127:   PetscObjectComposeFunction((PetscObject)nep,"NEPCISSGetRefinement_C",NEPCISSGetRefinement_CISS);
1128:   /* set default values of parameters */
1129:   ctx->N       = 32;
1130:   ctx->L       = 16;
1131:   ctx->M       = ctx->N/4;
1132:   ctx->delta   = 1e-12;
1133:   ctx->L_max   = 64;
1134:   ctx->spurious_threshold = 1e-4;
1135:   ctx->usest   = PETSC_FALSE;
1136:   ctx->isreal  = PETSC_FALSE;
1137:   ctx->refine_outer = 1;
1138:   ctx->refine_inner = 1;
1139:   ctx->refine_blocksize = 1;
1140:   ctx->num_subcomm = 1;
1141:   return(0);
1142: }