Actual source code: nleigs.c

slepc-3.8.3 2018-04-03
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-2017, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */
 10: /*
 11:    SLEPc nonlinear eigensolver: "nleigs"

 13:    Method: NLEIGS

 15:    Algorithm:

 17:        Fully rational Krylov method for nonlinear eigenvalue problems.

 19:    References:

 21:        [1] S. Guttel et al., "NLEIGS: A class of robust fully rational Krylov
 22:            method for nonlinear eigenvalue problems", SIAM J. Sci. Comput.
 23:            36(6):A2842-A2864, 2014.
 24: */

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

 29: #define  LBPOINTS  100   /* default value of the maximum number of Leja-Bagby points */
 30: #define  NDPOINTS  1e4   /* number of discretization points */

 32: typedef struct {
 33:   PetscInt       nmat;      /* number of interpolation points */
 34:   PetscScalar    *s,*xi;    /* Leja-Bagby points */
 35:   PetscScalar    *beta;     /* scaling factors */
 36:   Mat            *D;        /* divided difference matrices */
 37:   PetscScalar    *coeffD;   /* coefficients for divided differences in split form */
 38:   PetscInt       nshifts;   /* provided number of shifts */
 39:   PetscScalar    *shifts;   /* user-provided shifts for the Rational Krylov variant */
 40:   PetscInt       nshiftsw;  /* actual number of shifts (1 if Krylov-Schur) */
 41:   PetscReal      ddtol;     /* tolerance for divided difference convergence */
 42:   PetscInt       ddmaxit;   /* maximum number of divided difference terms */
 43:   PetscReal      keep;      /* restart parameter */
 44:   PetscBool      lock;      /* locking/non-locking variant */
 45:   PetscInt       idxrk;     /* index of next shift to use */
 46:   KSP            *ksp;      /* ksp array for storing shift factorizations */
 47:   Vec            vrn;       /* random vector with normally distributed value */
 48:   void           *singularitiesctx;
 49:   PetscErrorCode (*computesingularities)(NEP,PetscInt*,PetscScalar*,void*);
 50: } NEP_NLEIGS;

 52: typedef struct {
 53:   PetscInt    nmat,maxnmat;
 54:   PetscScalar *coeff;
 55:   Mat         *A;
 56:   Vec         t;
 57: } ShellMatCtx;

 59: PETSC_STATIC_INLINE PetscErrorCode NEPNLEIGSSetShifts(NEP nep)
 60: {
 61:   NEP_NLEIGS *ctx = (NEP_NLEIGS*)nep->data;

 64:   if (!ctx->nshifts) {
 65:     ctx->shifts = &nep->target;
 66:     ctx->nshiftsw = 1;
 67:   } else ctx->nshiftsw = ctx->nshifts;
 68:   return(0);
 69: }

 71: static PetscErrorCode NEPNLEIGSBackTransform(PetscObject ob,PetscInt n,PetscScalar *valr,PetscScalar *vali)
 72: {
 73:   NEP         nep;
 74:   PetscInt    j;
 75: #if !defined(PETSC_USE_COMPLEX)
 76:   PetscScalar t;
 77: #endif

 80:   nep = (NEP)ob;
 81: #if !defined(PETSC_USE_COMPLEX)
 82:   for (j=0;j<n;j++) {
 83:     if (vali[j] == 0) valr[j] = 1.0 / valr[j] + nep->target;
 84:     else {
 85:       t = valr[j] * valr[j] + vali[j] * vali[j];
 86:       valr[j] = valr[j] / t + nep->target;
 87:       vali[j] = - vali[j] / t;
 88:     }
 89:   }
 90: #else
 91:   for (j=0;j<n;j++) {
 92:     valr[j] = 1.0 / valr[j] + nep->target;
 93:   }
 94: #endif
 95:   return(0);
 96: }

 98: /* Computes the roots of a polynomial */
 99: static PetscErrorCode NEPNLEIGSAuxiliarPRootFinder(PetscInt deg,PetscScalar *polcoeffs,PetscScalar *wr,PetscScalar *wi,PetscBool *avail)
100: {
102:   PetscScalar    *C,*work;
103:   PetscBLASInt   n_,info,lwork;
104:   PetscInt       i;
105: #if defined(PETSC_USE_COMPLEX)
106:   PetscReal      *rwork;
107: #endif
108: #if defined(PETSC_HAVE_ESSL)
109:   PetscScalar    sdummy;
110:   PetscBLASInt   idummy,io=0;
111:   PetscScalar    *wri;
112: #endif

115: #if defined(PETSC_MISSING_LAPACK_GEEV)
116:   *avail = PETSC_FALSE;
117: #else
118:   *avail = PETSC_TRUE;
119:   if (deg>0) {
120:     PetscCalloc1(deg*deg,&C);
121:     PetscBLASIntCast(deg,&n_);
122:     for (i=0;i<deg-1;i++) {
123:       C[(deg+1)*i+1]   = 1.0;
124:       C[(deg-1)*deg+i] = -polcoeffs[deg-i]/polcoeffs[0];
125:     }
126:     C[deg*deg+-1] = -polcoeffs[1]/polcoeffs[0];
127:     PetscBLASIntCast(3*deg,&lwork);

129:     PetscFPTrapPush(PETSC_FP_TRAP_OFF);
130: #if !defined(PETSC_HAVE_ESSL)
131: #if !defined(PETSC_USE_COMPLEX)
132:     PetscMalloc1(lwork,&work);
133:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&n_,C,&n_,wr,wi,NULL,&n_,NULL,&n_,work,&lwork,&info));
134:     if (info) *avail = PETSC_FALSE;
135:     PetscFree(work); 
136: #else
137:     PetscMalloc2(2*deg,&rwork,lwork,&work);
138:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&n_,C,&n_,wr,NULL,&n_,NULL,&n_,work,&lwork,rwork,&info));
139:     if (info) *avail = PETSC_FALSE;
140:     PetscFree2(rwork,work);
141: #endif
142: #else
143:     PetscMalloc2(lwork,&work,2*deg,&wri);
144:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_(&io,C,&n_,wri,&sdummy,&idummy,&idummy,&n_,work,&lwork));
145: #if !defined(PETSC_USE_COMPLEX)
146:     for (i=0;i<deg;i++) {
147:       wr[i] = wri[2*i];
148:       wi[i] = wri[2*i+1];
149:     }
150: #else
151:     for (i=0;i<deg;i++) wr[i] = wri[i];
152: #endif
153:     PetscFree2(work,wri);
154: #endif
155:     PetscFPTrapPop();
156:     PetscFree(C);
157:   }
158: #endif
159:   return(0);
160: }

162: static PetscErrorCode NEPNLEIGSAuxiliarRmDuplicates(PetscInt nin,PetscScalar *pin,PetscInt *nout,PetscScalar *pout)
163: {
164:   PetscInt i,j;

167:   for (i=0;i<nin;i++) {
168:     pout[(*nout)++] = pin[i];
169:     for (j=0;j<*nout-1;j++)
170:       if (PetscAbsScalar(pin[i]-pout[j])<PETSC_MACHINE_EPSILON*100) {
171:         (*nout)--;
172:         break;
173:       }
174:   }
175:   return(0);
176: }

178: static PetscErrorCode NEPNLEIGSFNSingularities(FN f,PetscInt *nisol,PetscScalar **isol,PetscBool *rational)
179: {
181:   FNCombineType  ctype;
182:   FN             f1,f2;
183:   PetscInt       i,nq,nisol1,nisol2;
184:   PetscScalar    *qcoeff,*wr,*wi,*isol1,*isol2;
185:   PetscBool      flg,avail,rat1,rat2;

188:   *rational = PETSC_FALSE;
189:   PetscObjectTypeCompare((PetscObject)f,FNRATIONAL,&flg);
190:   if (flg) {
191:     *rational = PETSC_TRUE;
192:     FNRationalGetDenominator(f,&nq,&qcoeff);
193:     if (nq>1) {
194:       PetscMalloc2(nq-1,&wr,nq-1,&wi);
195:       NEPNLEIGSAuxiliarPRootFinder(nq-1,qcoeff,wr,wi,&avail);
196:       if (avail) {
197:         PetscCalloc1(nq-1,isol);
198:         *nisol = 0;
199:         for (i=0;i<nq-1;i++) 
200: #if !defined(PETSC_USE_COMPLEX)
201:           if (wi[i]==0)
202: #endif 
203:             (*isol)[(*nisol)++] = wr[i];
204:         nq = *nisol; *nisol = 0;
205:         for (i=0;i<nq;i++) wr[i] = (*isol)[i];
206:         NEPNLEIGSAuxiliarRmDuplicates(nq,wr,nisol,*isol);
207:         PetscFree2(wr,wi);
208:       } else { *nisol=0; *isol = NULL; }
209:     } else { *nisol = 0; *isol = NULL; }
210:     PetscFree(qcoeff);
211:   }
212:   PetscObjectTypeCompare((PetscObject)f,FNCOMBINE,&flg);
213:   if (flg) {
214:     FNCombineGetChildren(f,&ctype,&f1,&f2);
215:     if (ctype != FN_COMBINE_COMPOSE && ctype != FN_COMBINE_DIVIDE) {
216:       NEPNLEIGSFNSingularities(f1,&nisol1,&isol1,&rat1);
217:       NEPNLEIGSFNSingularities(f2,&nisol2,&isol2,&rat2);
218:       if (nisol1+nisol2>0) {
219:         PetscCalloc1(nisol1+nisol2,isol);
220:         *nisol = 0; 
221:         NEPNLEIGSAuxiliarRmDuplicates(nisol1,isol1,nisol,*isol);
222:         NEPNLEIGSAuxiliarRmDuplicates(nisol2,isol2,nisol,*isol);
223:       }
224:       *rational = (rat1&&rat2)?PETSC_TRUE:PETSC_FALSE;
225:       PetscFree(isol1);
226:       PetscFree(isol2);
227:     }
228:   }
229:   return(0);
230: }

232: static PetscErrorCode NEPNLEIGSRationalSingularities(NEP nep,PetscInt *ndptx,PetscScalar *dxi,PetscBool *rational)
233: {
235:   PetscInt       nt,i,nisol;
236:   FN             f;
237:   PetscScalar    *isol;
238:   PetscBool      rat;

241:   *rational = PETSC_TRUE;
242:   *ndptx = 0;
243:   NEPGetSplitOperatorInfo(nep,&nt,NULL);
244:   for (i=0;i<nt;i++) {
245:     NEPGetSplitOperatorTerm(nep,i,NULL,&f);
246:     NEPNLEIGSFNSingularities(f,&nisol,&isol,&rat);
247:     if (nisol) {
248:       NEPNLEIGSAuxiliarRmDuplicates(nisol,isol,ndptx,dxi);
249:       PetscFree(isol);
250:     }
251:     *rational = ((*rational)&&rat)?PETSC_TRUE:PETSC_FALSE;
252:   }
253:   return(0);
254: }

256: static PetscErrorCode NEPNLEIGSLejaBagbyPoints(NEP nep)
257: {
259:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
260:   PetscInt       i,k,ndpt=NDPOINTS,ndptx=NDPOINTS;
261:   PetscScalar    *ds,*dsi,*dxi,*nrs,*nrxi,*s=ctx->s,*xi=ctx->xi,*beta=ctx->beta;
262:   PetscReal      maxnrs,minnrxi;
263:   PetscBool      rational;
264: #if !defined(PETSC_USE_COMPLEX)
265:   PetscReal      a,b,h;
266: #endif

269:   PetscMalloc5(ndpt+1,&ds,ndpt+1,&dsi,ndpt,&dxi,ndpt+1,&nrs,ndpt,&nrxi);

271:   /* Discretize the target region boundary */
272:   RGComputeContour(nep->rg,ndpt,ds,dsi);
273: #if !defined(PETSC_USE_COMPLEX)
274:   for (i=0;i<ndpt;i++) if (dsi[i]!=0.0) break;
275:   if (i<ndpt) {
276:     if (nep->problem_type==NEP_RATIONAL) {
277:       /* Select a segment in the real axis */
278:       RGComputeBoundingBox(nep->rg,&a,&b,NULL,NULL);
279:       if (a<=-PETSC_MAX_REAL || b>=PETSC_MAX_REAL) SETERRQ(PetscObjectComm((PetscObject)nep),1,"NLEIGS requires a bounded target set");
280:       h = (b-a)/ndpt;
281:       for (i=0;i<ndpt;i++) {ds[i] = a+h*i; dsi[i] = 0.0;}
282:     } else SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"NLEIGS with real arithmetic requires the target set to be included in the real axis");
283:   }
284: #endif
285:   /* Discretize the singularity region */
286:   if (ctx->computesingularities) {
287:     (ctx->computesingularities)(nep,&ndptx,dxi,ctx->singularitiesctx);
288:   } else {
289:     if (nep->problem_type==NEP_RATIONAL) {
290:       NEPNLEIGSRationalSingularities(nep,&ndptx,dxi,&rational);
291:       if (!rational) SETERRQ(PetscObjectComm((PetscObject)nep),1,"Failed to determine singularities automatically in rational problem; consider solving the problem as general");
292:     } else ndptx = 0;
293:   }

295:   /* Look for Leja-Bagby points in the discretization sets */
296:   s[0]    = ds[0];
297:   xi[0]   = (ndptx>0)?dxi[0]:PETSC_INFINITY;
298:   if (PetscAbsScalar(xi[0])<10*PETSC_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)nep),1,"Singularity point %D is nearly zero: %g; consider removing the singularity or shifting the problem",0,(double)PetscAbsScalar(xi[0]));
299:   beta[0] = 1.0; /* scaling factors are also computed here */
300:   for (i=0;i<ndpt;i++) {
301:     nrs[i] = 1.0;
302:     nrxi[i] = 1.0;
303:   }
304:   for (k=1;k<ctx->ddmaxit;k++) {
305:     maxnrs = 0.0;
306:     minnrxi = PETSC_MAX_REAL;
307:     for (i=0;i<ndpt;i++) {
308:       nrs[i] *= ((ds[i]-s[k-1])/(1.0-ds[i]/xi[k-1]))/beta[k-1];
309:       if (PetscAbsScalar(nrs[i])>maxnrs) {maxnrs = PetscAbsScalar(nrs[i]); s[k] = ds[i];}
310:     }
311:     if (ndptx>k) {
312:       for (i=1;i<ndptx;i++) {
313:         nrxi[i] *= ((dxi[i]-s[k-1])/(1.0-dxi[i]/xi[k-1]))/beta[k-1];
314:         if (PetscAbsScalar(nrxi[i])<minnrxi) {minnrxi = PetscAbsScalar(nrxi[i]); xi[k] = dxi[i];}
315:       }
316:       if (PetscAbsScalar(xi[k])<10*PETSC_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)nep),1,"Singularity point %D is nearly zero: %g; consider removing the singularity or shifting the problem",k,(double)PetscAbsScalar(xi[k]));
317:     } else xi[k] = PETSC_INFINITY;
318:     beta[k] = maxnrs;
319:   }
320:   PetscFree5(ds,dsi,dxi,nrs,nrxi);
321:   return(0);
322: }

324: static PetscErrorCode NEPNLEIGSEvalNRTFunct(NEP nep,PetscInt k,PetscScalar sigma,PetscScalar *b)
325: {
326:   NEP_NLEIGS  *ctx=(NEP_NLEIGS*)nep->data;
327:   PetscInt    i;
328:   PetscScalar *beta=ctx->beta,*s=ctx->s,*xi=ctx->xi;

331:   b[0] = 1.0/beta[0];
332:   for (i=0;i<k;i++) {
333:     b[i+1] = ((sigma-s[i])*b[i])/(beta[i+1]*(1.0-sigma/xi[i]));
334:   }
335:   return(0);
336: }

338: static PetscErrorCode MatMult_Fun(Mat A,Vec x,Vec y)
339: {
341:   ShellMatCtx    *ctx;
342:   PetscInt       i;

345:   MatShellGetContext(A,(void**)&ctx);
346:   MatMult(ctx->A[0],x,y);
347:   if (ctx->coeff[0]!=1.0) { VecScale(y,ctx->coeff[0]); }
348:   for (i=1;i<ctx->nmat;i++) {
349:     MatMult(ctx->A[i],x,ctx->t);
350:     VecAXPY(y,ctx->coeff[i],ctx->t);
351:   }
352:   return(0);
353: }

355: static PetscErrorCode MatMultTranspose_Fun(Mat A,Vec x,Vec y)
356: {
358:   ShellMatCtx    *ctx;
359:   PetscInt       i;

362:   MatShellGetContext(A,(void**)&ctx);
363:   MatMultTranspose(ctx->A[0],x,y);
364:   if (ctx->coeff[0]!=1.0) { VecScale(y,ctx->coeff[0]); }
365:   for (i=1;i<ctx->nmat;i++) {
366:     MatMultTranspose(ctx->A[i],x,ctx->t);
367:     VecAXPY(y,ctx->coeff[i],ctx->t);
368:   }
369:   return(0);
370: }

372: static PetscErrorCode MatGetDiagonal_Fun(Mat A,Vec diag)
373: {
375:   ShellMatCtx    *ctx;
376:   PetscInt       i;

379:   MatShellGetContext(A,(void**)&ctx);
380:   MatGetDiagonal(ctx->A[0],diag);
381:   if (ctx->coeff[0]!=1.0) { VecScale(diag,ctx->coeff[0]); }
382:   for (i=1;i<ctx->nmat;i++) {
383:     MatGetDiagonal(ctx->A[i],ctx->t);
384:     VecAXPY(diag,ctx->coeff[i],ctx->t);
385:   }
386:   return(0);
387: }

389: static PetscErrorCode MatDuplicate_Fun(Mat A,MatDuplicateOption op,Mat *B)
390: {
391:   PetscInt       n,i;
392:   ShellMatCtx    *ctxnew,*ctx;
393:   void           (*fun)();

397:   MatShellGetContext(A,(void**)&ctx);
398:   PetscNew(&ctxnew);
399:   ctxnew->nmat = ctx->nmat;
400:   ctxnew->maxnmat = ctx->maxnmat;
401:   PetscMalloc2(ctxnew->maxnmat,&ctxnew->A,ctxnew->maxnmat,&ctxnew->coeff);
402:   for (i=0;i<ctx->nmat;i++) {
403:     PetscObjectReference((PetscObject)ctx->A[i]);
404:     ctxnew->A[i] = ctx->A[i];
405:     ctxnew->coeff[i] = ctx->coeff[i];
406:   }
407:   MatGetSize(ctx->A[0],&n,NULL);
408:   VecDuplicate(ctx->t,&ctxnew->t);
409:   MatCreateShell(PETSC_COMM_WORLD,n,n,n,n,(void*)ctxnew,B);
410:   MatShellGetOperation(A,MATOP_MULT,&fun);
411:   MatShellSetOperation(*B,MATOP_MULT,fun);
412:   MatShellGetOperation(A,MATOP_MULT_TRANSPOSE,&fun);
413:   MatShellSetOperation(*B,MATOP_MULT_TRANSPOSE,fun);
414:   MatShellGetOperation(A,MATOP_GET_DIAGONAL,&fun);
415:   MatShellSetOperation(*B,MATOP_GET_DIAGONAL,fun);
416:   MatShellGetOperation(A,MATOP_DUPLICATE,&fun);
417:   MatShellSetOperation(*B,MATOP_DUPLICATE,fun);
418:   MatShellGetOperation(A,MATOP_DESTROY,&fun);
419:   MatShellSetOperation(*B,MATOP_DESTROY,fun);
420:   MatShellGetOperation(A,MATOP_AXPY,&fun);
421:   MatShellSetOperation(*B,MATOP_AXPY,fun);
422:   return(0);
423: }

425: static PetscErrorCode MatDestroy_Fun(Mat A)
426: {
427:   ShellMatCtx    *ctx;
429:   PetscInt       i;

432:   if (A) {
433:     MatShellGetContext(A,(void**)&ctx);
434:     for (i=0;i<ctx->nmat;i++) {
435:       MatDestroy(&ctx->A[i]);
436:     }
437:     VecDestroy(&ctx->t);
438:     PetscFree2(ctx->A,ctx->coeff);
439:     PetscFree(ctx);
440:   }
441:   return(0);
442: }

444: static PetscErrorCode MatAXPY_Fun(Mat Y,PetscScalar a,Mat X,MatStructure str)
445: {
446:   ShellMatCtx    *ctxY,*ctxX;
448:   PetscInt       i,j;
449:   PetscBool      found;

452:   MatShellGetContext(Y,(void**)&ctxY);
453:   MatShellGetContext(X,(void**)&ctxX);
454:   for (i=0;i<ctxX->nmat;i++) {
455:     found = PETSC_FALSE;
456:     for (j=0;!found&&j<ctxY->nmat;j++) {
457:       if (ctxX->A[i]==ctxY->A[j]) {
458:         found = PETSC_TRUE;
459:         ctxY->coeff[j] += a*ctxX->coeff[i];
460:       }
461:     }
462:     if (!found) {
463:       ctxY->coeff[ctxY->nmat] = a*ctxX->coeff[i];
464:       ctxY->A[ctxY->nmat++] = ctxX->A[i];
465:       PetscObjectReference((PetscObject)ctxX->A[i]);
466:     }
467:   }
468:   return(0);
469: }

471: static PetscErrorCode MatScale_Fun(Mat M,PetscScalar a)
472: {
473:   ShellMatCtx    *ctx;
475:   PetscInt       i;

478:   MatShellGetContext(M,(void**)&ctx);
479:   for (i=0;i<ctx->nmat;i++) ctx->coeff[i] *= a;
480:   return(0);
481: }

483: static PetscErrorCode NLEIGSMatToMatShellArray(Mat M,Mat *Ms,PetscInt maxnmat)
484: {
486:   ShellMatCtx    *ctx;
487:   PetscInt       n;
488:   PetscBool      has;

491:   MatHasOperation(M,MATOP_DUPLICATE,&has);
492:   if (!has) SETERRQ(PetscObjectComm((PetscObject)M),1,"MatDuplicate operation required");
493:   PetscNew(&ctx);
494:   ctx->maxnmat = maxnmat;
495:   PetscMalloc2(ctx->maxnmat,&ctx->A,ctx->maxnmat,&ctx->coeff);
496:   MatDuplicate(M,MAT_COPY_VALUES,&ctx->A[0]);
497:   ctx->nmat = 1;
498:   ctx->coeff[0] = 1.0;
499:   MatCreateVecs(M,&ctx->t,NULL);
500:   MatGetSize(M,&n,NULL);
501:   MatCreateShell(PetscObjectComm((PetscObject)M),n,n,n,n,(void*)ctx,Ms);
502:   MatShellSetOperation(*Ms,MATOP_MULT,(void(*)())MatMult_Fun);
503:   MatShellSetOperation(*Ms,MATOP_MULT_TRANSPOSE,(void(*)())MatMultTranspose_Fun);
504:   MatShellSetOperation(*Ms,MATOP_GET_DIAGONAL,(void(*)())MatGetDiagonal_Fun);
505:   MatShellSetOperation(*Ms,MATOP_DUPLICATE,(void(*)())MatDuplicate_Fun);
506:   MatShellSetOperation(*Ms,MATOP_DESTROY,(void(*)())MatDestroy_Fun);
507:   MatShellSetOperation(*Ms,MATOP_AXPY,(void(*)())MatAXPY_Fun);
508:   MatShellSetOperation(*Ms,MATOP_SCALE,(void(*)())MatScale_Fun);
509:   return(0);
510: }

512: static PetscErrorCode NEPNLEIGSNormEstimation(NEP nep,Mat M,PetscReal *norm,Vec *w)
513: {
514:   PetscScalar    *z,*x,*y;
515:   PetscReal      tr;
516:   Vec            X=w[0],Y=w[1];
517:   PetscInt       n,i;
518:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
519:   PetscRandom    rand;

523:   if (!ctx->vrn) {
524:     /* generate a random vector with normally distributed entries with the Box-Muller transform */
525:     BVGetRandomContext(nep->V,&rand);
526:     MatCreateVecs(M,&ctx->vrn,NULL);
527:     VecSetRandom(X,rand);
528:     VecSetRandom(Y,rand);
529:     VecGetLocalSize(ctx->vrn,&n);
530:     VecGetArray(ctx->vrn,&z);
531:     VecGetArray(X,&x);
532:     VecGetArray(Y,&y);
533:     for (i=0;i<n;i++) {
534: #if defined(PETSC_USE_COMPLEX)
535:       z[i] = PetscSqrtReal(-2.0*PetscLogReal(PetscRealPart(x[i])))*PetscCosReal(2.0*PETSC_PI*PetscRealPart(y[i]));
536:       z[i] += PETSC_i*(PetscSqrtReal(-2.0*PetscLogReal(PetscImaginaryPart(x[i])))*PetscCosReal(2.0*PETSC_PI*PetscImaginaryPart(y[i])));
537: #else
538:       z[i] = PetscSqrtReal(-2.0*PetscLogReal(x[i]))*PetscCosReal(2.0*PETSC_PI*y[i]);
539: #endif
540:     }
541:     VecRestoreArray(ctx->vrn,&z);
542:     VecRestoreArray(X,&x);
543:     VecRestoreArray(Y,&y);
544:     VecNorm(ctx->vrn,NORM_2,&tr);
545:     VecScale(ctx->vrn,1/tr);
546:   }
547:   /* matrix-free norm estimator of Ipsen http://www4.ncsu.edu/~ipsen/ps/slides_ima.pdf */
548:   MatGetSize(M,&n,NULL);
549:   MatMult(M,ctx->vrn,X);
550:   VecNorm(X,NORM_2,norm);
551:   *norm *= PetscSqrtReal((PetscReal)n);
552:   return(0);
553: }

555: static PetscErrorCode NEPNLEIGSDividedDifferences_split(NEP nep)
556: {
558:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
559:   PetscInt       k,j,i,maxnmat,nmax;
560:   PetscReal      norm0,norm,*matnorm;
561:   PetscScalar    *s=ctx->s,*beta=ctx->beta,*xi=ctx->xi,*b,alpha,*coeffs,*pK,*pH,sone=1.0;
562:   Mat            T,Ts,K,H;
563:   PetscBool      shell,hasmnorm,matrix=PETSC_TRUE;
564:   PetscBLASInt   n_;

567:   nmax = ctx->ddmaxit;
568:   PetscMalloc1(nep->nt*nmax,&ctx->coeffD);
569:   PetscMalloc3(nmax+1,&b,nmax+1,&coeffs,nep->nt,&matnorm);
570:   for (j=0;j<nep->nt;j++) {
571:     MatHasOperation(nep->A[j],MATOP_NORM,&hasmnorm);
572:     if (!hasmnorm) break;
573:     MatNorm(nep->A[j],NORM_INFINITY,matnorm+j);
574:   }
575:   /* Try matrix functions scheme */
576:   PetscCalloc2(nmax*nmax,&pK,nmax*nmax,&pH);
577:   for (i=0;i<nmax-1;i++) {
578:     pK[(nmax+1)*i]   = 1.0;
579:     pK[(nmax+1)*i+1] = beta[i+1]/xi[i];
580:     pH[(nmax+1)*i]   = s[i];
581:     pH[(nmax+1)*i+1] = beta[i+1];
582:   }
583:   pH[nmax*nmax-1] = s[nmax-1];
584:   pK[nmax*nmax-1] = 1.0;
585:   PetscBLASIntCast(nmax,&n_);
586:   PetscStackCallBLAS("BLAStrsm",BLAStrsm_("R","L","N","U",&n_,&n_,&sone,pK,&n_,pH,&n_));
587:   /* The matrix to be used is in H. K will be a work-space matrix */
588:   MatCreateSeqDense(PETSC_COMM_SELF,nmax,nmax,pH,&H);
589:   MatCreateSeqDense(PETSC_COMM_SELF,nmax,nmax,pK,&K);
590:   for (j=0;matrix&&j<nep->nt;j++) {
591:     PetscPushErrorHandler(PetscIgnoreErrorHandler,NULL);
592:     FNEvaluateFunctionMat(nep->f[j],H,K);
593:     PetscPopErrorHandler();
594:     if (!ierr) { 
595:       for (i=0;i<nmax;i++) { ctx->coeffD[j+i*nep->nt] = pK[i]*beta[0]; }
596:     } else {
597:       matrix = PETSC_FALSE;
598:       PetscFPTrapPop();
599:     }
600:   }
601:   MatDestroy(&H);
602:   MatDestroy(&K);
603:   if (!matrix) {
604:     for (j=0;j<nep->nt;j++) {
605:       FNEvaluateFunction(nep->f[j],s[0],ctx->coeffD+j);
606:       ctx->coeffD[j] *= beta[0];
607:     }
608:   }
609:   if (hasmnorm) {
610:     norm0 = 0.0;
611:     for (j=0;j<nep->nt;j++) norm0 += matnorm[j]*PetscAbsScalar(ctx->coeffD[j]);
612:   } else {
613:     norm0 = 0.0;
614:     for (j=0;j<nep->nt;j++) norm0 = PetscMax(PetscAbsScalar(ctx->coeffD[j]),norm0);
615:   }
616:   ctx->nmat = ctx->ddmaxit;
617:   for (k=1;k<ctx->ddmaxit;k++) {
618:     if (!matrix) {
619:       NEPNLEIGSEvalNRTFunct(nep,k,s[k],b);
620:       for (i=0;i<nep->nt;i++) {
621:         FNEvaluateFunction(nep->f[i],s[k],ctx->coeffD+k*nep->nt+i);
622:         for (j=0;j<k;j++) {
623:           ctx->coeffD[k*nep->nt+i] -= b[j]*ctx->coeffD[i+nep->nt*j];
624:         }
625:         ctx->coeffD[k*nep->nt+i] /= b[k];
626:       }
627:     }
628:     if (hasmnorm) {
629:       norm = 0.0;
630:       for (j=0;j<nep->nt;j++) norm += matnorm[j]*PetscAbsScalar(ctx->coeffD[k*nep->nt+j]);
631:     } else {
632:       norm = 0.0;
633:       for (j=0;j<nep->nt;j++) norm = PetscMax(PetscAbsScalar(ctx->coeffD[k*nep->nt+j]),norm);
634:     }
635:     if (norm/norm0 < ctx->ddtol) {
636:       ctx->nmat = k+1;
637:       break;
638:     }
639:   }
640:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->ksp); }
641:   PetscObjectTypeCompare((PetscObject)nep->A[0],MATSHELL,&shell);
642:   maxnmat = PetscMax(ctx->ddmaxit,nep->nt);
643:   for (i=0;i<ctx->nshiftsw;i++) {
644:     NEPNLEIGSEvalNRTFunct(nep,ctx->nmat-1,ctx->shifts[i],coeffs);
645:     if (!shell) {
646:       MatDuplicate(nep->A[0],MAT_COPY_VALUES,&T);
647:     } else {
648:       NLEIGSMatToMatShellArray(nep->A[0],&T,maxnmat);
649:     }
650:     alpha = 0.0;
651:     for (j=0;j<ctx->nmat;j++) alpha += coeffs[j]*ctx->coeffD[j*nep->nt];
652:     MatScale(T,alpha);
653:     for (k=1;k<nep->nt;k++) {
654:       alpha = 0.0;
655:       for (j=0;j<ctx->nmat;j++) alpha += coeffs[j]*ctx->coeffD[j*nep->nt+k];
656:       if (shell) {
657:         NLEIGSMatToMatShellArray(nep->A[k],&Ts,maxnmat);
658:       }
659:       MatAXPY(T,alpha,shell?Ts:nep->A[k],nep->mstr);
660:       if (shell) {
661:         MatDestroy(&Ts);
662:       }
663:     }
664:     KSPSetOperators(ctx->ksp[i],T,T);
665:     KSPSetUp(ctx->ksp[i]);
666:     MatDestroy(&T);
667:   }
668:   PetscFree3(b,coeffs,matnorm);
669:   PetscFree2(pK,pH);
670:   return(0);
671: }

673: static PetscErrorCode NEPNLEIGSDividedDifferences_callback(NEP nep)
674: {
676:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
677:   PetscInt       k,j,i,maxnmat;
678:   PetscReal      norm0,norm;
679:   PetscScalar    *s=ctx->s,*beta=ctx->beta,*b,*coeffs;
680:   Mat            *D=ctx->D,T;
681:   PetscBool      shell,has,vec=PETSC_FALSE;
682:   Vec            w[2];

685:   PetscMalloc2(ctx->ddmaxit+1,&b,ctx->ddmaxit+1,&coeffs);
686:   T = nep->function;
687:   NEPComputeFunction(nep,s[0],T,T);
688:   PetscObjectTypeCompare((PetscObject)T,MATSHELL,&shell);
689:   maxnmat = PetscMax(ctx->ddmaxit,nep->nt);
690:   if (!shell) {
691:     MatDuplicate(T,MAT_COPY_VALUES,&D[0]);
692:   } else {
693:     NLEIGSMatToMatShellArray(T,&D[0],maxnmat);
694:   }
695:   if (beta[0]!=1.0) {
696:     MatScale(D[0],1.0/beta[0]);
697:   }
698:   MatHasOperation(D[0],MATOP_NORM,&has);
699:   if (has) {
700:     MatNorm(D[0],NORM_FROBENIUS,&norm0);
701:   } else {
702:     MatCreateVecs(D[0],NULL,&w[0]);
703:     VecDuplicate(w[0],&w[1]);
704:     vec = PETSC_TRUE;
705:     NEPNLEIGSNormEstimation(nep,D[0],&norm0,w);
706:   }
707:   ctx->nmat = ctx->ddmaxit;
708:   for (k=1;k<ctx->ddmaxit;k++) {
709:     NEPNLEIGSEvalNRTFunct(nep,k,s[k],b);
710:     NEPComputeFunction(nep,s[k],T,T);
711:     if (!shell) {
712:       MatDuplicate(T,MAT_COPY_VALUES,&D[k]);
713:     } else {
714:       NLEIGSMatToMatShellArray(T,&D[k],maxnmat);
715:     }
716:     for (j=0;j<k;j++) {
717:       MatAXPY(D[k],-b[j],D[j],nep->mstr);
718:     }
719:     MatScale(D[k],1.0/b[k]);
720:     MatHasOperation(D[k],MATOP_NORM,&has);
721:     if (has) {
722:       MatNorm(D[k],NORM_FROBENIUS,&norm);
723:     } else {
724:       if(!vec) {
725:         MatCreateVecs(D[k],NULL,&w[0]);
726:         VecDuplicate(w[0],&w[1]);
727:         vec = PETSC_TRUE;
728:       }
729:       NEPNLEIGSNormEstimation(nep,D[k],&norm,w);
730:     }
731:     if (norm/norm0 < ctx->ddtol) {
732:       ctx->nmat = k+1;
733:       break;
734:     }
735:   }
736:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->ksp); }
737:   for (i=0;i<ctx->nshiftsw;i++) {
738:     NEPNLEIGSEvalNRTFunct(nep,ctx->nmat-1,ctx->shifts[i],coeffs);
739:     MatDuplicate(ctx->D[0],MAT_COPY_VALUES,&T);
740:     if (coeffs[0]!=1.0) { MatScale(T,coeffs[0]); }
741:     for (j=1;j<ctx->nmat;j++) {
742:       MatAXPY(T,coeffs[j],ctx->D[j],nep->mstr);
743:     }
744:     KSPSetOperators(ctx->ksp[i],T,T);
745:     KSPSetUp(ctx->ksp[i]);
746:     MatDestroy(&T);
747:   }
748:   PetscFree2(b,coeffs);
749:   if (vec) {
750:     VecDestroy(&w[0]);
751:     VecDestroy(&w[1]);
752:   }
753:   return(0);
754: }

756: /*
757:    NEPKrylovConvergence - This is the analogue to EPSKrylovConvergence.
758: */
759: static PetscErrorCode NEPNLEIGSKrylovConvergence(NEP nep,PetscScalar *S,PetscInt ld,PetscInt nq,PetscScalar *H,PetscBool getall,PetscInt kini,PetscInt nits,PetscScalar betak,PetscReal betah,PetscInt *kout,Vec *w)
760: {
762:   PetscInt       k,newk,marker,inside;
763:   PetscScalar    re,im;
764:   PetscReal      resnorm,tt;
765:   PetscBool      istrivial;
766:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

769:   RGIsTrivial(nep->rg,&istrivial);
770:   marker = -1;
771:   if (nep->trackall) getall = PETSC_TRUE;
772:   for (k=kini;k<kini+nits;k++) {
773:     /* eigenvalue */
774:     re = nep->eigr[k];
775:     im = nep->eigi[k];
776:     if (!istrivial) {
777:       if (!ctx->nshifts) {
778:         NEPNLEIGSBackTransform((PetscObject)nep,1,&re,&im);
779:       }
780:       RGCheckInside(nep->rg,1,&re,&im,&inside);
781:       if (marker==-1 && inside<0) marker = k;
782:     }
783:     newk = k;
784:     DSVectors(nep->ds,DS_MAT_X,&newk,&resnorm);
785:     tt = (ctx->nshifts)?SlepcAbsEigenvalue(betak-nep->eigr[k]*betah,nep->eigi[k]*betah):betah;
786:     resnorm *=  PetscAbsReal(tt);
787:     /* error estimate */
788:     (*nep->converged)(nep,nep->eigr[k],nep->eigi[k],resnorm,&nep->errest[k],nep->convergedctx);
789:     if (marker==-1 && nep->errest[k] >= nep->tol) marker = k;
790:     if (newk==k+1) {
791:       nep->errest[k+1] = nep->errest[k];
792:       k++;
793:     }
794:     if (marker!=-1 && !getall) break;
795:   }
796:   if (marker!=-1) k = marker;
797:   *kout = k;
798:   return(0);
799: }

801: PetscErrorCode NEPSetUp_NLEIGS(NEP nep)
802: {
804:   PetscInt       k,in;
805:   PetscScalar    zero=0.0;
806:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
807:   SlepcSC        sc;
808:   PetscBool      istrivial;

811:   NEPSetDimensions_Default(nep,nep->nev,&nep->ncv,&nep->mpd);
812:   if (nep->ncv>nep->nev+nep->mpd) SETERRQ(PetscObjectComm((PetscObject)nep),1,"The value of ncv must not be larger than nev+mpd");
813:   if (!nep->max_it) nep->max_it = PetscMax(5000,2*nep->n/nep->ncv);
814:   if (!ctx->ddmaxit) ctx->ddmaxit = LBPOINTS;
815:   RGIsTrivial(nep->rg,&istrivial);
816:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"NEPNLEIGS requires a nontrivial region defining the target set");
817:   if (!nep->which) nep->which = NEP_TARGET_MAGNITUDE;

819:   /* Initialize the NLEIGS context structure */
820:   k = ctx->ddmaxit;
821:   PetscMalloc4(k,&ctx->s,k,&ctx->xi,k,&ctx->beta,k,&ctx->D);
822:   nep->data = ctx;
823:   if (nep->tol==PETSC_DEFAULT) nep->tol = SLEPC_DEFAULT_TOL;
824:   if (ctx->ddtol==PETSC_DEFAULT) ctx->ddtol = nep->tol/10.0;
825:   if (!ctx->keep) ctx->keep = 0.5;

827:   /* Compute Leja-Bagby points and scaling values */
828:   NEPNLEIGSLejaBagbyPoints(nep);
829:   if (nep->problem_type!=NEP_RATIONAL) {
830:     RGCheckInside(nep->rg,1,&nep->target,&zero,&in);
831:     if (in<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"The target is not inside the target set");
832:   }

834:   /* Compute the divided difference matrices */
835:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
836:     NEPNLEIGSDividedDifferences_split(nep);
837:   } else {
838:     NEPNLEIGSDividedDifferences_callback(nep);
839:   }
840:   NEPAllocateSolution(nep,ctx->nmat);
841:   NEPSetWorkVecs(nep,4);

843:   /* set-up DS and transfer split operator functions */
844:   DSSetType(nep->ds,ctx->nshifts?DSGNHEP:DSNHEP);
845:   DSAllocate(nep->ds,nep->ncv+1);
846:   DSGetSlepcSC(nep->ds,&sc);
847:   if (!ctx->nshifts) {
848:     sc->map = NEPNLEIGSBackTransform;
849:     DSSetExtraRow(nep->ds,PETSC_TRUE);
850:   }
851:   sc->mapobj        = (PetscObject)nep;
852:   sc->rg            = nep->rg;
853:   sc->comparison    = nep->sc->comparison;
854:   sc->comparisonctx = nep->sc->comparisonctx;
855:   return(0);
856: }

858: /*
859:   Norm of [sp;sq]
860: */
861: static PetscErrorCode NEPTOARSNorm2(PetscInt n,PetscScalar *S,PetscReal *norm)
862: {
864:   PetscBLASInt   n_,one=1;

867:   PetscBLASIntCast(n,&n_);
868:   *norm = BLASnrm2_(&n_,S,&one);
869:   return(0);
870: }

872: /*
873:  Computes GS orthogonalization   [z;x] - [Sp;Sq]*y,
874:  where y = ([Sp;Sq]'*[z;x]).
875:    k: Column from S to be orthogonalized against previous columns.
876:    Sq = Sp+ld
877:    dim(work)=k;
878: */
879: static PetscErrorCode NEPTOAROrth2(NEP nep,PetscScalar *S,PetscInt ld,PetscInt deg,PetscInt k,PetscScalar *y,PetscReal *norm,PetscBool *lindep,PetscScalar *work)
880: {
882:   PetscBLASInt   n_,lds_,k_,one=1;
883:   PetscScalar    sonem=-1.0,sone=1.0,szero=0.0,*x0,*x,*c;
884:   PetscInt       i,lds=deg*ld,n;
885:   PetscReal      eta,onorm;

888:   BVGetOrthogonalization(nep->V,NULL,NULL,&eta,NULL);
889:   n = k+deg-1;
890:   PetscBLASIntCast(n,&n_);
891:   PetscBLASIntCast(deg*ld,&lds_);
892:   PetscBLASIntCast(k,&k_); /* Number of vectors to orthogonalize against them */
893:   c = work;
894:   x0 = S+k*lds;
895:   PetscStackCall("BLASgemv",BLASgemv_("C",&n_,&k_,&sone,S,&lds_,x0,&one,&szero,y,&one));
896:   for (i=1;i<deg;i++) {
897:     x = S+i*ld+k*lds;
898:     PetscStackCall("BLASgemv",BLASgemv_("C",&n_,&k_,&sone,S+i*ld,&lds_,x,&one,&sone,y,&one));
899:   }
900:   for (i=0;i<deg;i++) {
901:     x= S+i*ld+k*lds;
902:     PetscStackCall("BLASgemv",BLASgemv_("N",&n_,&k_,&sonem,S+i*ld,&lds_,y,&one,&sone,x,&one));
903:   }
904:   NEPTOARSNorm2(lds,S+k*lds,&onorm);
905:   /* twice */
906:   PetscStackCall("BLASgemv",BLASgemv_("C",&n_,&k_,&sone,S,&lds_,x0,&one,&szero,c,&one));
907:   for (i=1;i<deg;i++) {
908:     x = S+i*ld+k*lds;
909:     PetscStackCall("BLASgemv",BLASgemv_("C",&n_,&k_,&sone,S+i*ld,&lds_,x,&one,&sone,c,&one));
910:   }
911:   for (i=0;i<deg;i++) {
912:     x= S+i*ld+k*lds;
913:     PetscStackCall("BLASgemv",BLASgemv_("N",&n_,&k_,&sonem,S+i*ld,&lds_,c,&one,&sone,x,&one));
914:   }
915:   for (i=0;i<k;i++) y[i] += c[i];
916:   if (norm) {
917:     NEPTOARSNorm2(lds,S+k*lds,norm);
918:     if (lindep) *lindep = (*norm < eta * onorm)?PETSC_TRUE:PETSC_FALSE;
919:   }
920:   return(0);
921: }

923: /*
924:   Extend the TOAR basis by applying the the matrix operator
925:   over a vector which is decomposed on the TOAR way
926:   Input:
927:     - S,V: define the latest Arnoldi vector (nv vectors in V)
928:   Output:
929:     - t: new vector extending the TOAR basis
930:     - r: temporally coefficients to compute the TOAR coefficients
931:          for the new Arnoldi vector
932:   Workspace: t_ (two vectors)
933: */
934: static PetscErrorCode NEPTOARExtendBasis(NEP nep,PetscInt idxrktg,PetscScalar *S,PetscInt ls,PetscInt nv,BV W,BV V,Vec t,PetscScalar *r,PetscInt lr,Vec *t_)
935: {
937:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
938:   PetscInt       deg=ctx->nmat-1,k,j;
939:   Vec            v=t_[0],q=t_[1],w;
940:   PetscScalar    *beta=ctx->beta,*s=ctx->s,*xi=ctx->xi,*coeffs,sigma;

943:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->ksp); }
944:   sigma = ctx->shifts[idxrktg];
945:   BVSetActiveColumns(nep->V,0,nv);
946:   PetscMalloc1(ctx->nmat,&coeffs);
947:   if (PetscAbsScalar(s[deg-2]-sigma)<100*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Breakdown in NLEIGS");
948:   /* i-part stored in (i-1) position */
949:   for (j=0;j<nv;j++) {
950:     r[(deg-2)*lr+j] = (S[(deg-2)*ls+j]+(beta[deg-1]/xi[deg-2])*S[(deg-1)*ls+j])/(s[deg-2]-sigma);
951:   }
952:   BVSetActiveColumns(W,0,deg);
953:   BVGetColumn(W,deg-1,&w);
954:   BVMultVec(V,1.0/beta[deg],0,w,S+(deg-1)*ls);
955:   BVRestoreColumn(W,deg-1,&w);
956:   BVGetColumn(W,deg-2,&w);
957:   BVMultVec(V,1.0,0.0,w,r+(deg-2)*lr);
958:   BVRestoreColumn(W,deg-2,&w);
959:   for (k=deg-2;k>0;k--) {
960:     if (PetscAbsScalar(s[k-1]-sigma)<100*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Breakdown in NLEIGS");
961:     for (j=0;j<nv;j++) r[(k-1)*lr+j] = (S[(k-1)*ls+j]+(beta[k]/xi[k-1])*S[k*ls+j]-beta[k]*(1.0-sigma/xi[k-1])*r[(k)*lr+j])/(s[k-1]-sigma);
962:     BVGetColumn(W,k-1,&w);
963:     BVMultVec(V,1.0,0.0,w,r+(k-1)*lr);
964:     BVRestoreColumn(W,k-1,&w);
965:   }
966:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
967:     for (j=0;j<ctx->nmat-2;j++) coeffs[j] = ctx->coeffD[nep->nt*j];
968:     coeffs[ctx->nmat-2] = ctx->coeffD[nep->nt*(ctx->nmat-1)];
969:     BVMultVec(W,1.0,0.0,v,coeffs);
970:     MatMult(nep->A[0],v,q);
971:     for (k=1;k<nep->nt;k++) {
972:       for (j=0;j<ctx->nmat-2;j++) coeffs[j] = ctx->coeffD[nep->nt*j+k];
973:       coeffs[ctx->nmat-2] = ctx->coeffD[nep->nt*(ctx->nmat-1)+k];
974:       BVMultVec(W,1.0,0,v,coeffs);
975:       MatMult(nep->A[k],v,t);
976:       VecAXPY(q,1.0,t);
977:     }
978:     KSPSolve(ctx->ksp[idxrktg],q,t);
979:     VecScale(t,-1.0);
980:   } else {
981:     for (k=0;k<deg-1;k++) {
982:       BVGetColumn(W,k,&w);
983:       MatMult(ctx->D[k],w,q);
984:       BVRestoreColumn(W,k,&w);
985:       BVInsertVec(W,k,q);
986:     }
987:     BVGetColumn(W,deg-1,&w);
988:     MatMult(ctx->D[deg],w,q);
989:     BVRestoreColumn(W,k,&w);
990:     BVInsertVec(W,k,q);
991:     for (j=0;j<ctx->nmat-1;j++) coeffs[j] = 1.0;
992:     BVMultVec(W,1.0,0.0,q,coeffs);
993:     KSPSolve(ctx->ksp[idxrktg],q,t);
994:     VecScale(t,-1.0);
995:   }
996:   PetscFree(coeffs);
997:   return(0);
998: }

1000: /*
1001:   Compute TOAR coefficients of the blocks of the new Arnoldi vector computed
1002: */
1003: static PetscErrorCode NEPTOARCoefficients(NEP nep,PetscScalar sigma,PetscInt nv,PetscScalar *S,PetscInt ls,PetscScalar *r,PetscInt lr,PetscScalar *x,PetscScalar *work)
1004: {
1006:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
1007:   PetscInt       k,j,d=ctx->nmat-1;
1008:   PetscScalar    *t=work;

1011:   NEPNLEIGSEvalNRTFunct(nep,d-1,sigma,t);
1012:   for (k=0;k<d-1;k++) {
1013:     for (j=0;j<=nv;j++) r[k*lr+j] += t[k]*x[j];
1014:   }
1015:   for (j=0;j<=nv;j++) r[(d-1)*lr+j] = t[d-1]*x[j];
1016:   return(0);
1017: }

1019: /*
1020:   Compute continuation vector coefficients for the Rational-Krylov run.
1021:   dim(work) >= (end-ini)*(end-ini+1) + end+1 + 2*(end-ini+1), dim(t) = end.
1022: */
1023: static PetscErrorCode NEPNLEIGS_RKcontinuation(NEP nep,PetscInt ini,PetscInt end,PetscScalar *K,PetscScalar *H,PetscInt ld,PetscScalar sigma,PetscScalar *S,PetscInt lds,PetscScalar *cont,PetscScalar *t,PetscScalar *work)
1024: {
1025: #if defined(PETSC_MISSING_LAPACK_GEQRF) || defined(SLEPC_MISSING_LAPACK_LARF)
1027:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GEQRF/LARF - Lapack routines are unavailable");
1028: #else
1030:   PetscScalar    *x,*W,*tau,sone=1.0,szero=0.0;
1031:   PetscInt       i,j,n1,n,nwu=0;
1032:   PetscBLASInt   info,n_,n1_,one=1,dim,lds_;
1033:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

1036:   if (!ctx->nshifts || !end) {
1037:     t[0] = 1;
1038:     PetscMemcpy(cont,S+end*lds,lds*sizeof(PetscScalar));
1039:   } else {
1040:     n   = end-ini;
1041:     n1  = n+1;
1042:     x   = work+nwu;
1043:     nwu += end+1;
1044:     tau = work+nwu;
1045:     nwu += n;
1046:     W   = work+nwu;
1047:     nwu += n1*n;
1048:     for (j=ini;j<end;j++) {
1049:       for (i=ini;i<=end;i++) W[(j-ini)*n1+i-ini] = K[j*ld+i] -H[j*ld+i]*sigma;
1050:     }
1051:     PetscBLASIntCast(n,&n_);
1052:     PetscBLASIntCast(n1,&n1_);
1053:     PetscBLASIntCast(end+1,&dim);
1054:     PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&n1_,&n_,W,&n1_,tau,work+nwu,&n1_,&info));
1055:     SlepcCheckLapackInfo("geqrf",info);
1056:     for (i=0;i<end;i++) t[i] = 0.0;
1057:     t[end] = 1.0;
1058:     for (j=n-1;j>=0;j--) {
1059:       for (i=0;i<ini+j;i++) x[i] = 0.0;
1060:       x[ini+j] = 1.0;
1061:       for (i=j+1;i<n1;i++) x[i+ini] = W[i+n1*j];
1062:       tau[j] = PetscConj(tau[j]);
1063:       PetscStackCallBLAS("LAPACKlarf",LAPACKlarf_("L",&dim,&one,x,&one,tau+j,t,&dim,work+nwu));
1064:     }
1065:     PetscBLASIntCast(lds,&lds_);
1066:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&lds_,&n1_,&sone,S,&lds_,t,&one,&szero,cont,&one));
1067:   }
1068:   return(0);
1069: #endif
1070: }

1072: /*
1073:   Compute a run of Arnoldi iterations
1074: */
1075: static PetscErrorCode NEPNLEIGSTOARrun(NEP nep,PetscInt *nq,PetscScalar *S,PetscInt ld,PetscScalar *K,PetscScalar *H,PetscInt ldh,BV W,BV V,PetscInt k,PetscInt *M,PetscBool *breakdown,Vec *t_)
1076: {
1078:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
1079:   PetscInt       i,j,p,m=*M,lwa,deg=ctx->nmat-1,lds=ld*deg,nqt=*nq;
1080:   Vec            t=t_[0];
1081:   PetscReal      norm;
1082:   PetscScalar    *x,*work,*tt,sigma,*cont;
1083:   PetscBool      lindep;

1086:   lwa = PetscMax(ld,deg)+(m+1)*(m+1)+4*(m+1);
1087:   PetscMalloc4(ld,&x,lwa,&work,m+1,&tt,lds,&cont);
1088:   for (j=k;j<m;j++) {
1089:     sigma = ctx->shifts[(++(ctx->idxrk))%ctx->nshiftsw];

1091:     /* Continuation vector */
1092:     NEPNLEIGS_RKcontinuation(nep,0,j,K,H,ldh,sigma,S,lds,cont,tt,work);

1094:     /* apply operator */
1095:     BVGetColumn(nep->V,nqt,&t);
1096:     NEPTOARExtendBasis(nep,(ctx->idxrk)%ctx->nshiftsw,cont,ld,nqt,W,V,t,S+(j+1)*lds,ld,t_+1);
1097:     BVRestoreColumn(nep->V,nqt,&t);

1099:     /* orthogonalize */
1100:     BVOrthogonalizeColumn(nep->V,nqt,x,&norm,&lindep);
1101:     if (!lindep) {
1102:       x[nqt] = norm;
1103:       BVScaleColumn(nep->V,nqt,1.0/norm);
1104:       nqt++;
1105:     } else x[nqt] = 0.0;

1107:     NEPTOARCoefficients(nep,sigma,*nq,cont,ld,S+(j+1)*lds,ld,x,work);

1109:     /* Level-2 orthogonalization */
1110:     NEPTOAROrth2(nep,S,ld,deg,j+1,H+j*ldh,&norm,breakdown,work);
1111:     H[j+1+ldh*j] = norm;
1112:     if (ctx->nshifts) {
1113:       for (i=0;i<=j;i++) K[i+ldh*j] = sigma*H[i+ldh*j] + tt[i];
1114:       K[j+1+ldh*j] = sigma*H[j+1+ldh*j];
1115:     }
1116:     *nq = nqt;
1117:     if (*breakdown) {
1118:       *M = j+1;
1119:       break;
1120:     }
1121:     for (p=0;p<deg;p++) {
1122:       for (i=0;i<=j+deg;i++) {
1123:         S[i+p*ld+(j+1)*lds] /= norm;
1124:       }
1125:     }
1126:   }
1127:   PetscFree4(x,work,tt,cont);
1128:   return(0);
1129: }

1131: /* dim(work)=5*ld*lds dim(rwork)=6*n */
1132: static PetscErrorCode NEPTOARTrunc(NEP nep,PetscScalar *S,PetscInt ld,PetscInt deg,PetscInt *nq,PetscInt cs1,PetscScalar *work,PetscReal *rwork)
1133: {
1134: #if defined(PETSC_MISSING_LAPACK_GESVD)
1136:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
1137: #else
1139:   PetscInt       lwa,nwu=0,nrwu=0;
1140:   PetscInt       j,i,n,lds=deg*ld,rk=0,rs1;
1141:   PetscScalar    *M,*V,*pU,t;
1142:   PetscReal      *sg,tol;
1143:   PetscBLASInt   cs1_,rs1_,cs1tdeg,n_,info,lw_;
1144:   Mat            U;

1147:   rs1 = *nq;
1148:   n = (rs1>deg*cs1)?deg*cs1:rs1;
1149:   lwa = 5*ld*lds;
1150:   M = work+nwu;
1151:   nwu += rs1*cs1*deg;
1152:   sg = rwork+nrwu;
1153:   nrwu += n;
1154:   pU = work+nwu;
1155:   nwu += rs1*n;
1156:   V = work+nwu;
1157:   nwu += deg*cs1*n;
1158:   for (i=0;i<cs1;i++) {
1159:     for (j=0;j<deg;j++) {
1160:       PetscMemcpy(M+(i+j*cs1)*rs1,S+i*lds+j*ld,rs1*sizeof(PetscScalar));
1161:     }
1162:   }
1163:   PetscBLASIntCast(n,&n_);
1164:   PetscBLASIntCast(cs1,&cs1_);
1165:   PetscBLASIntCast(rs1,&rs1_);
1166:   PetscBLASIntCast(cs1*deg,&cs1tdeg);
1167:   PetscBLASIntCast(lwa-nwu,&lw_);
1168: #if !defined (PETSC_USE_COMPLEX)
1169:   PetscStackCall("LAPACKgesvd",LAPACKgesvd_("S","S",&rs1_,&cs1tdeg,M,&rs1_,sg,pU,&rs1_,V,&n_,work+nwu,&lw_,&info));
1170: #else
1171:   PetscStackCall("LAPACKgesvd",LAPACKgesvd_("S","S",&rs1_,&cs1tdeg,M,&rs1_,sg,pU,&rs1_,V,&n_,work+nwu,&lw_,rwork+nrwu,&info));
1172: #endif
1173:   SlepcCheckLapackInfo("gesvd",info);

1175:   /* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
1176:   MatCreateSeqDense(PETSC_COMM_SELF,rs1,cs1+deg-1,pU,&U);
1177:   BVSetActiveColumns(nep->V,0,rs1);
1178:   BVMultInPlace(nep->V,U,0,cs1+deg-1);
1179:   BVSetActiveColumns(nep->V,0,cs1+deg-1);
1180:   MatDestroy(&U);
1181:   tol = PetscMax(rs1,deg*cs1)*PETSC_MACHINE_EPSILON*sg[0];
1182:   for (i=0;i<PetscMin(n_,cs1tdeg);i++) if (sg[i]>tol) rk++;
1183:   rk = PetscMin(cs1+deg-1,rk);

1185:   /* Update S */
1186:   PetscMemzero(S,lds*ld*sizeof(PetscScalar));
1187:   for (i=0;i<rk;i++) {
1188:     t = sg[i];
1189:     PetscStackCall("BLASscal",BLASscal_(&cs1tdeg,&t,V+i,&n_));
1190:   }
1191:   for (j=0;j<cs1;j++) {
1192:     for (i=0;i<deg;i++) {
1193:       PetscMemcpy(S+j*lds+i*ld,V+(cs1*i+j)*n,rk*sizeof(PetscScalar));
1194:     }
1195:   }
1196:   *nq = rk;
1197:   return(0);
1198: #endif
1199: }

1201: /*
1202:   S <- S*Q
1203:   columns s-s+ncu of S
1204:   rows 0-sr of S
1205:   size(Q) qr x ncu
1206:   dim(work)=sr*ncu
1207: */
1208: static PetscErrorCode NEPTOARSupdate(PetscScalar *S,PetscInt ld,PetscInt deg,PetscInt sr,PetscInt s,PetscInt ncu,PetscInt qr,PetscScalar *Q,PetscInt ldq,PetscScalar *work)
1209: {
1211:   PetscScalar    a=1.0,b=0.0;
1212:   PetscBLASInt   sr_,ncu_,ldq_,lds_,qr_;
1213:   PetscInt       j,lds=deg*ld,i;

1216:   PetscBLASIntCast(sr,&sr_);
1217:   PetscBLASIntCast(qr,&qr_);
1218:   PetscBLASIntCast(ncu,&ncu_);
1219:   PetscBLASIntCast(lds,&lds_);
1220:   PetscBLASIntCast(ldq,&ldq_);
1221:   for (i=0;i<deg;i++) {
1222:     PetscStackCall("BLASgemm",BLASgemm_("N","N",&sr_,&ncu_,&qr_,&a,S+i*ld,&lds_,Q,&ldq_,&b,work,&sr_));
1223:     for (j=0;j<ncu;j++) {
1224:       PetscMemcpy(S+lds*(s+j)+i*ld,work+j*sr,sr*sizeof(PetscScalar));
1225:     }
1226:   }
1227:   return(0);
1228: }

1230: PetscErrorCode NEPSolve_NLEIGS(NEP nep)
1231: {
1233:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
1234:   PetscInt       i,j,k=0,l,nv=0,ld,lds,off,ldds,rs1,nq=0,newn;
1235:   PetscInt       lwa,lrwa,nwu=0,nrwu=0,deg=ctx->nmat-1,nconv=0;
1236:   PetscScalar    *S,*Q,*work,*H,*pU,*K,betak=0,*Hc,*eigr,*eigi;
1237:   PetscReal      betah,norm,*rwork;
1238:   PetscBool      breakdown=PETSC_FALSE,lindep;
1239:   Mat            U;
1240:   BV             W;

1243:   ld = nep->ncv+deg;
1244:   lds = deg*ld;
1245:   lwa = (deg+6)*ld*lds;
1246:   lrwa = 7*lds;
1247:   DSGetLeadingDimension(nep->ds,&ldds);
1248:   PetscMalloc4(lwa,&work,lrwa,&rwork,lds*ld,&S,ldds*ldds,&Hc);
1249:   PetscMemzero(S,lds*ld*sizeof(PetscScalar));
1250:   if (!ctx->nshifts) {
1251:     PetscMalloc2(nep->ncv,&eigr,nep->ncv,&eigi);
1252:   } else { eigr = nep->eigr; eigi = nep->eigi; }
1253:   BVDuplicateResize(nep->V,PetscMax(nep->nt-1,ctx->nmat-1),&W);

1255:   /* Get the starting vector */
1256:   for (i=0;i<deg;i++) {
1257:     BVSetRandomColumn(nep->V,i);
1258:     BVOrthogonalizeColumn(nep->V,i,S+i*ld,&norm,&lindep);
1259:     if (!lindep) {
1260:       BVScaleColumn(nep->V,i,1/norm);
1261:       S[i+i*ld] = norm;
1262:       nq++;
1263:     }
1264:   }
1265:   if (!nq) SETERRQ(PetscObjectComm((PetscObject)nep),1,"NEP: Problem with initial vector");
1266:   NEPTOARSNorm2(lds,S,&norm);
1267:   for (j=0;j<deg;j++) {
1268:     for (i=0;i<=j;i++) S[i+j*ld] /= norm;
1269:   }

1271:   /* Restart loop */
1272:   l = 0;
1273:   while (nep->reason == NEP_CONVERGED_ITERATING) {
1274:     nep->its++;

1276:     /* Compute an nv-step Krylov relation */
1277:     nv = PetscMin(nep->nconv+nep->mpd,nep->ncv);
1278:     if (ctx->nshifts) { DSGetArray(nep->ds,DS_MAT_A,&K); }
1279:     DSGetArray(nep->ds,ctx->nshifts?DS_MAT_B:DS_MAT_A,&H);
1280:     NEPNLEIGSTOARrun(nep,&nq,S,ld,K,H,ldds,W,nep->V,nep->nconv+l,&nv,&breakdown,nep->work);
1281:     betah = PetscAbsScalar(H[(nv-1)*ldds+nv]);
1282:     DSRestoreArray(nep->ds,ctx->nshifts?DS_MAT_B:DS_MAT_A,&H);
1283:     if (ctx->nshifts) {
1284:       betak = K[(nv-1)*ldds+nv];
1285:       DSRestoreArray(nep->ds,DS_MAT_A,&K);
1286:     }
1287:     DSSetDimensions(nep->ds,nv,0,nep->nconv,nep->nconv+l);
1288:     if (l==0) {
1289:       DSSetState(nep->ds,DS_STATE_INTERMEDIATE);
1290:     } else {
1291:       DSSetState(nep->ds,DS_STATE_RAW);
1292:     }

1294:     /* Solve projected problem */
1295:     if (ctx->nshifts) {
1296:       DSGetArray(nep->ds,DS_MAT_B,&H);
1297:       PetscMemcpy(Hc,H,ldds*ldds*sizeof(PetscScalar));
1298:       DSRestoreArray(nep->ds,DS_MAT_B,&H);
1299:     }
1300:     DSSolve(nep->ds,nep->eigr,nep->eigi);
1301:     DSSort(nep->ds,nep->eigr,nep->eigi,NULL,NULL,NULL);
1302:     if (!ctx->nshifts) {
1303:       DSUpdateExtraRow(nep->ds);
1304:     }
1305:     DSSynchronize(nep->ds,nep->eigr,nep->eigi);

1307:     /* Check convergence */
1308:     NEPNLEIGSKrylovConvergence(nep,S,ld,nq,Hc,PETSC_FALSE,nep->nconv,nv-nep->nconv,betak,betah,&k,nep->work);
1309:     (*nep->stopping)(nep,nep->its,nep->max_it,k,nep->nev,&nep->reason,nep->stoppingctx);
1310:     nconv = k;

1312:     /* Update l */
1313:     if (nep->reason != NEP_CONVERGED_ITERATING || breakdown) l = 0;
1314:     else {
1315:       l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
1316:       if (!breakdown) {
1317:         /* Prepare the Rayleigh quotient for restart */
1318:         if (!ctx->nshifts) {
1319:           DSTruncate(nep->ds,k+l);
1320:           DSGetDimensions(nep->ds,&newn,NULL,NULL,NULL,NULL);
1321:           l = newn-k;
1322:         } else {
1323:           DSGetArray(nep->ds,DS_MAT_Q,&Q);
1324:           DSGetArray(nep->ds,DS_MAT_B,&H);
1325:           DSGetArray(nep->ds,DS_MAT_A,&K);
1326:           for (i=ctx->lock?k:0;i<k+l;i++) {
1327:             H[k+l+i*ldds] = betah*Q[nv-1+i*ldds];
1328:             K[k+l+i*ldds] = betak*Q[nv-1+i*ldds];
1329:           }
1330:           DSRestoreArray(nep->ds,DS_MAT_B,&H);
1331:           DSRestoreArray(nep->ds,DS_MAT_A,&K);
1332:           DSRestoreArray(nep->ds,DS_MAT_Q,&Q);
1333:           DSSetDimensions(nep->ds,k+l,0,nep->nconv,0);
1334:         }
1335:       }
1336:     }
1337:     if (!ctx->lock && l>0) { l += k; k = 0; }

1339:     /* Update S */
1340:     off = nep->nconv*ldds;
1341:     DSGetArray(nep->ds,ctx->nshifts?DS_MAT_Z:DS_MAT_Q,&Q);
1342:     NEPTOARSupdate(S,ld,deg,nq,nep->nconv,k+l-nep->nconv,nv,Q+off,ldds,work+nwu);
1343:     DSRestoreArray(nep->ds,ctx->nshifts?DS_MAT_Z:DS_MAT_Q,&Q);

1345:     /* Copy last column of S */
1346:     PetscMemcpy(S+lds*(k+l),S+lds*nv,lds*sizeof(PetscScalar));
1347:     if (nep->reason == NEP_CONVERGED_ITERATING) {
1348:       if (breakdown) {

1350:         /* Stop if breakdown */
1351:         PetscInfo2(nep,"Breakdown (it=%D norm=%g)\n",nep->its,(double)betah);
1352:         nep->reason = NEP_DIVERGED_BREAKDOWN;
1353:       } else {
1354:         /* Truncate S */
1355:         NEPTOARTrunc(nep,S,ld,deg,&nq,k+l+1,work+nwu,rwork+nrwu);
1356:       }
1357:     }
1358:     nep->nconv = k;
1359:     if (!ctx->nshifts) {
1360:       for (i=0;i<nv;i++) { eigr[i] = nep->eigr[i]; eigi[i] = nep->eigi[i]; }
1361:       NEPNLEIGSBackTransform((PetscObject)nep,nv,eigr,eigi);
1362:     }
1363:     NEPMonitor(nep,nep->its,nconv,eigr,eigi,nep->errest,nv);
1364:   }
1365:   nep->nconv = nconv;
1366:   if (nep->nconv>0) {
1367:     /* Extract invariant pair */
1368:     NEPTOARTrunc(nep,S,ld,deg,&nq,nep->nconv,work+nwu,rwork+nrwu);
1369:     /* Update vectors V = V*S or V=V*S*H */
1370:     rs1 = nep->nconv;
1371:     if (ctx->nshifts) {
1372:       DSGetArray(nep->ds,DS_MAT_B,&H);
1373:       NEPTOARSupdate(S,ld,deg,rs1,0,nep->nconv,nep->nconv,H,ldds,work+nwu);
1374:       DSRestoreArray(nep->ds,DS_MAT_B,&H);
1375:     }
1376:     PetscMalloc1(rs1*nep->nconv,&pU);
1377:     for (i=0;i<nep->nconv;i++) {
1378:       PetscMemcpy(pU+i*rs1,S+i*lds,rs1*sizeof(PetscScalar));
1379:     }
1380:     MatCreateSeqDense(PETSC_COMM_SELF,rs1,nep->nconv,pU,&U);
1381:     BVSetActiveColumns(nep->V,0,rs1);
1382:     BVMultInPlace(nep->V,U,0,nep->nconv);
1383:     BVSetActiveColumns(nep->V,0,nep->nconv);
1384:     MatDestroy(&U);
1385:     PetscFree(pU);
1386:   }
1387:   /* truncate Schur decomposition and change the state to raw so that
1388:      DSVectors() computes eigenvectors from scratch */
1389:   DSSetDimensions(nep->ds,nep->nconv,0,0,0);
1390:   DSSetState(nep->ds,DS_STATE_RAW);

1392:   PetscFree4(work,rwork,S,Hc);
1393:   /* Map eigenvalues back to the original problem */
1394:   if (!ctx->nshifts) {
1395:     NEPNLEIGSBackTransform((PetscObject)nep,nep->nconv,nep->eigr,nep->eigi);
1396:     PetscFree2(eigr,eigi);
1397:   }
1398:   BVDestroy(&W);
1399:   return(0);
1400: }

1402: static PetscErrorCode NEPNLEIGSSetSingularitiesFunction_NLEIGS(NEP nep,PetscErrorCode (*fun)(NEP,PetscInt*,PetscScalar*,void*),void *ctx)
1403: {
1404:   NEP_NLEIGS *nepctx=(NEP_NLEIGS*)nep->data;

1407:   if (fun) nepctx->computesingularities = fun;
1408:   if (ctx) nepctx->singularitiesctx     = ctx;
1409:   nep->state = NEP_STATE_INITIAL;
1410:   return(0);
1411: }

1413: /*@C
1414:    NEPNLEIGSSetSingularitiesFunction - Sets a user function to compute a discretization
1415:    of the singularity set (where T(.) is not analytic).

1417:    Logically Collective on NEP

1419:    Input Parameters:
1420: +  nep - the NEP context
1421: .  fun - user function (if NULL then NEP retains any previously set value)
1422: -  ctx - [optional] user-defined context for private data for the function
1423:          (may be NULL, in which case NEP retains any previously set value)

1425:    Calling Sequence of fun:
1426: $   fun(NEP nep,PetscInt *maxnp,PetscScalar *xi,void *ctx)

1428: +   nep   - the NEP context
1429: .   maxnp - on input number of requested points in the discretization (can be set)
1430: .   xi    - computed values of the discretization
1431: -   ctx   - optional context, as set by NEPNLEIGSSetSingularitiesFunction()

1433:    Notes:
1434:    The user-defined function can set a smaller value of maxnp if necessary.
1435:    It is wrong to return a larger value.

1437:    If the problem type has been set to rational with NEPSetProblemType(),
1438:    then it is not necessary to set the singularities explicitly since the
1439:    solver will try to determine them automatically.

1441:    Level: intermediate

1443: .seealso: NEPNLEIGSGetSingularitiesFunction(), NEPSetProblemType()
1444: @*/
1445: PetscErrorCode NEPNLEIGSSetSingularitiesFunction(NEP nep,PetscErrorCode (*fun)(NEP,PetscInt*,PetscScalar*,void*),void *ctx)
1446: {

1451:   PetscTryMethod(nep,"NEPNLEIGSSetSingularitiesFunction_C",(NEP,PetscErrorCode(*)(NEP,PetscInt*,PetscScalar*,void*),void*),(nep,fun,ctx));
1452:   return(0);
1453: }

1455: static PetscErrorCode NEPNLEIGSGetSingularitiesFunction_NLEIGS(NEP nep,PetscErrorCode (**fun)(NEP,PetscInt*,PetscScalar*,void*),void **ctx)
1456: {
1457:   NEP_NLEIGS *nepctx=(NEP_NLEIGS*)nep->data;

1460:   if (fun) *fun = nepctx->computesingularities;
1461:   if (ctx) *ctx = nepctx->singularitiesctx;
1462:   return(0);
1463: }

1465: /*@C
1466:    NEPNLEIGSGetSingularitiesFunction - Returns the Function and optionally the user
1467:    provided context for computing a discretization of the singularity set.

1469:    Not Collective

1471:    Input Parameter:
1472: .  nep - the nonlinear eigensolver context

1474:    Output Parameters:
1475: +  fun - location to put the function (or NULL)
1476: -  ctx - location to stash the function context (or NULL)

1478:    Level: advanced

1480: .seealso: NEPNLEIGSSetSingularitiesFunction()
1481: @*/
1482: PetscErrorCode NEPNLEIGSGetSingularitiesFunction(NEP nep,PetscErrorCode (**fun)(NEP,PetscInt*,PetscScalar*,void*),void **ctx)
1483: {

1488:   PetscUseMethod(nep,"NEPNLEIGSGetSingularitiesFunction_C",(NEP,PetscErrorCode(**)(NEP,PetscInt*,PetscScalar*,void*),void**),(nep,fun,ctx));
1489:   return(0);
1490: }

1492: static PetscErrorCode NEPNLEIGSSetRestart_NLEIGS(NEP nep,PetscReal keep)
1493: {
1494:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

1497:   if (keep==PETSC_DEFAULT) ctx->keep = 0.5;
1498:   else {
1499:     if (keep<0.1 || keep>0.9) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"The keep argument must be in the range [0.1,0.9]");
1500:     ctx->keep = keep;
1501:   }
1502:   return(0);
1503: }

1505: /*@
1506:    NEPNLEIGSSetRestart - Sets the restart parameter for the NLEIGS
1507:    method, in particular the proportion of basis vectors that must be kept
1508:    after restart.

1510:    Logically Collective on NEP

1512:    Input Parameters:
1513: +  nep  - the nonlinear eigensolver context
1514: -  keep - the number of vectors to be kept at restart

1516:    Options Database Key:
1517: .  -nep_nleigs_restart - Sets the restart parameter

1519:    Notes:
1520:    Allowed values are in the range [0.1,0.9]. The default is 0.5.

1522:    Level: advanced

1524: .seealso: NEPNLEIGSGetRestart()
1525: @*/
1526: PetscErrorCode NEPNLEIGSSetRestart(NEP nep,PetscReal keep)
1527: {

1533:   PetscTryMethod(nep,"NEPNLEIGSSetRestart_C",(NEP,PetscReal),(nep,keep));
1534:   return(0);
1535: }

1537: static PetscErrorCode NEPNLEIGSGetRestart_NLEIGS(NEP nep,PetscReal *keep)
1538: {
1539:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

1542:   *keep = ctx->keep;
1543:   return(0);
1544: }

1546: /*@
1547:    NEPNLEIGSGetRestart - Gets the restart parameter used in the NLEIGS method.

1549:    Not Collective

1551:    Input Parameter:
1552: .  nep - the nonlinear eigensolver context

1554:    Output Parameter:
1555: .  keep - the restart parameter

1557:    Level: advanced

1559: .seealso: NEPNLEIGSSetRestart()
1560: @*/
1561: PetscErrorCode NEPNLEIGSGetRestart(NEP nep,PetscReal *keep)
1562: {

1568:   PetscUseMethod(nep,"NEPNLEIGSGetRestart_C",(NEP,PetscReal*),(nep,keep));
1569:   return(0);
1570: }

1572: static PetscErrorCode NEPNLEIGSSetLocking_NLEIGS(NEP nep,PetscBool lock)
1573: {
1574:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

1577:   ctx->lock = lock;
1578:   return(0);
1579: }

1581: /*@
1582:    NEPNLEIGSSetLocking - Choose between locking and non-locking variants of
1583:    the NLEIGS method.

1585:    Logically Collective on NEP

1587:    Input Parameters:
1588: +  nep  - the nonlinear eigensolver context
1589: -  lock - true if the locking variant must be selected

1591:    Options Database Key:
1592: .  -nep_nleigs_locking - Sets the locking flag

1594:    Notes:
1595:    The default is to lock converged eigenpairs when the method restarts.
1596:    This behaviour can be changed so that all directions are kept in the
1597:    working subspace even if already converged to working accuracy (the
1598:    non-locking variant).

1600:    Level: advanced

1602: .seealso: NEPNLEIGSGetLocking()
1603: @*/
1604: PetscErrorCode NEPNLEIGSSetLocking(NEP nep,PetscBool lock)
1605: {

1611:   PetscTryMethod(nep,"NEPNLEIGSSetLocking_C",(NEP,PetscBool),(nep,lock));
1612:   return(0);
1613: }

1615: static PetscErrorCode NEPNLEIGSGetLocking_NLEIGS(NEP nep,PetscBool *lock)
1616: {
1617:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

1620:   *lock = ctx->lock;
1621:   return(0);
1622: }

1624: /*@
1625:    NEPNLEIGSGetLocking - Gets the locking flag used in the NLEIGS method.

1627:    Not Collective

1629:    Input Parameter:
1630: .  nep - the nonlinear eigensolver context

1632:    Output Parameter:
1633: .  lock - the locking flag

1635:    Level: advanced

1637: .seealso: NEPNLEIGSSetLocking()
1638: @*/
1639: PetscErrorCode NEPNLEIGSGetLocking(NEP nep,PetscBool *lock)
1640: {

1646:   PetscUseMethod(nep,"NEPNLEIGSGetLocking_C",(NEP,PetscBool*),(nep,lock));
1647:   return(0);
1648: }

1650: static PetscErrorCode NEPNLEIGSSetInterpolation_NLEIGS(NEP nep,PetscReal tol,PetscInt degree)
1651: {
1653:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;

1656:   if (tol == PETSC_DEFAULT) {
1657:     ctx->ddtol = PETSC_DEFAULT;
1658:     nep->state = NEP_STATE_INITIAL;
1659:   } else {
1660:     if (tol <= 0.0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of tol. Must be > 0");
1661:     ctx->ddtol = tol;
1662:   }
1663:   if (degree == PETSC_DEFAULT || degree == PETSC_DECIDE) {
1664:     ctx->ddmaxit = 0;
1665:     if (nep->state) { NEPReset(nep); }
1666:     nep->state = NEP_STATE_INITIAL;
1667:   } else {
1668:     if (degree <= 0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of degree. Must be > 0");
1669:     if (ctx->ddmaxit != degree) {
1670:       ctx->ddmaxit = degree;
1671:       if (nep->state) { NEPReset(nep); }
1672:       nep->state = NEP_STATE_INITIAL;
1673:     }
1674:   }
1675:   return(0);
1676: }

1678: /*@
1679:    NEPNLEIGSSetInterpolation - Sets the tolerance and maximum degree
1680:    when building the interpolation via divided differences.

1682:    Logically Collective on NEP

1684:    Input Parameters:
1685: +  nep    - the nonlinear eigensolver context
1686: .  tol    - tolerance to stop computing divided differences
1687: -  degree - maximum degree of interpolation

1689:    Options Database Key:
1690: +  -nep_nleigs_interpolation_tol <tol> - Sets the tolerance to stop computing divided differences
1691: -  -nep_nleigs_interpolation_degree <degree> - Sets the maximum degree of interpolation

1693:    Notes:
1694:    Use PETSC_DEFAULT for either argument to assign a reasonably good value.

1696:    Level: advanced

1698: .seealso: NEPNLEIGSGetInterpolation()
1699: @*/
1700: PetscErrorCode NEPNLEIGSSetInterpolation(NEP nep,PetscReal tol,PetscInt degree)
1701: {

1708:   PetscTryMethod(nep,"NEPNLEIGSSetInterpolation_C",(NEP,PetscReal,PetscInt),(nep,tol,degree));
1709:   return(0);
1710: }

1712: static PetscErrorCode NEPNLEIGSGetInterpolation_NLEIGS(NEP nep,PetscReal *tol,PetscInt *degree)
1713: {
1714:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

1717:   if (tol)    *tol    = ctx->ddtol;
1718:   if (degree) *degree = ctx->ddmaxit;
1719:   return(0);
1720: }

1722: /*@
1723:    NEPNLEIGSGetInterpolation - Gets the tolerance and maximum degree
1724:    when building the interpolation via divided differences.

1726:    Not Collective

1728:    Input Parameter:
1729: .  nep - the nonlinear eigensolver context

1731:    Output Parameter:
1732: +  tol    - tolerance to stop computing divided differences
1733: -  degree - maximum degree of interpolation

1735:    Level: advanced

1737: .seealso: NEPNLEIGSSetInterpolation()
1738: @*/
1739: PetscErrorCode NEPNLEIGSGetInterpolation(NEP nep,PetscReal *tol,PetscInt *degree)
1740: {

1745:   PetscTryMethod(nep,"NEPNLEIGSGetInterpolation_C",(NEP,PetscReal*,PetscInt*),(nep,tol,degree));
1746:   return(0);
1747: }

1749: static PetscErrorCode NEPNLEIGSSetRKShifts_NLEIGS(NEP nep,PetscInt ns,PetscScalar *shifts)
1750: {
1752:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
1753:   PetscInt       i;

1756:   if (ns<=0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_WRONG,"Number of shifts must be positive");
1757:   if (ctx->nshifts) { PetscFree(ctx->shifts); }
1758:   for (i=0;i<ctx->nshiftsw;i++) { KSPDestroy(&ctx->ksp[i]); }
1759:   PetscFree(ctx->ksp);
1760:   ctx->ksp = NULL;
1761:   PetscMalloc1(ns,&ctx->shifts);
1762:   for (i=0;i<ns;i++) ctx->shifts[i] = shifts[i];
1763:   ctx->nshifts = ns;
1764:   nep->state   = NEP_STATE_INITIAL;
1765:   return(0);
1766: }

1768: /*@C
1769:    NEPNLEIGSSetRKShifts - Sets a list of shifts to be used in the Rational
1770:    Krylov method.

1772:    Logically Collective on NEP

1774:    Input Parameters:
1775: +  nep    - the nonlinear eigensolver context
1776: .  ns     - number of shifts
1777: -  shifts - array of scalar values specifying the shifts

1779:    Options Database Key:
1780: .  -nep_nleigs_rk_shifts - Sets the list of shifts

1782:    Notes:
1783:    If only one shift is provided, the built subspace built is equivalent to
1784:    shift-and-invert Krylov-Schur (provided that the absolute convergence
1785:    criterion is used).

1787:    In the case of real scalars, complex shifts are not allowed. In the
1788:    command line, a comma-separated list of complex values can be provided with
1789:    the format [+/-][realnumber][+/-]realnumberi with no spaces, e.g.
1790:    -nep_nleigs_rk_shifts 1.0+2.0i,1.5+2.0i,1.0+1.5i

1792:    Level: advanced

1794: .seealso: NEPNLEIGSGetRKShifts()
1795: @*/
1796: PetscErrorCode NEPNLEIGSSetRKShifts(NEP nep,PetscInt ns,PetscScalar *shifts)
1797: {

1804:   PetscTryMethod(nep,"NEPNLEIGSSetRKShifts_C",(NEP,PetscInt,PetscScalar*),(nep,ns,shifts));
1805:   return(0);
1806: }

1808: static PetscErrorCode NEPNLEIGSGetRKShifts_NLEIGS(NEP nep,PetscInt *ns,PetscScalar **shifts)
1809: {
1811:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
1812:   PetscInt       i;

1815:   *ns = ctx->nshifts;
1816:   if (ctx->nshifts) {
1817:     PetscMalloc1(ctx->nshifts,shifts);
1818:     for (i=0;i<ctx->nshifts;i++) (*shifts)[i] = ctx->shifts[i];
1819:   }
1820:   return(0);
1821: }

1823: /*@C
1824:    NEPNLEIGSGetRKShifts - Gets the list of shifts used in the Rational
1825:    Krylov method.

1827:    Not Collective

1829:    Input Parameter:
1830: .  nep - the nonlinear eigensolver context

1832:    Output Parameter:
1833: +  ns     - number of shifts
1834: -  shifts - array of shifts

1836:    Level: advanced

1838: .seealso: NEPNLEIGSSetRKShifts()
1839: @*/
1840: PetscErrorCode NEPNLEIGSGetRKShifts(NEP nep,PetscInt *ns,PetscScalar **shifts)
1841: {

1848:   PetscTryMethod(nep,"NEPNLEIGSGetRKShifts_C",(NEP,PetscInt*,PetscScalar**),(nep,ns,shifts));
1849:   return(0);
1850: }

1852: #define SHIFTMAX 30

1854: PetscErrorCode NEPSetFromOptions_NLEIGS(PetscOptionItems *PetscOptionsObject,NEP nep)
1855: {
1857:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
1858:   PetscInt       i,k;
1859:   PetscBool      flg1,flg2,b;
1860:   PetscReal      r;
1861:   PetscScalar    array[SHIFTMAX];
1862:   PC             pc;
1863:   PCType         pctype;
1864:   KSPType        ksptype;

1867:   PetscOptionsHead(PetscOptionsObject,"NEP NLEIGS Options");

1869:     PetscOptionsReal("-nep_nleigs_restart","Proportion of vectors kept after restart","NEPNLEIGSSetRestart",0.5,&r,&flg1);
1870:     if (flg1) { NEPNLEIGSSetRestart(nep,r); }

1872:     PetscOptionsBool("-nep_nleigs_locking","Choose between locking and non-locking variants","NEPNLEIGSSetLocking",PETSC_FALSE,&b,&flg1);
1873:     if (flg1) { NEPNLEIGSSetLocking(nep,b); }

1875:     NEPNLEIGSGetInterpolation(nep,&r,&i);
1876:     if (!i) i = PETSC_DEFAULT;
1877:     PetscOptionsInt("-nep_nleigs_interpolation_degree","Maximum number of terms for interpolation via divided differences","NEPNLEIGSSetInterpolation",i,&i,&flg1);
1878:     PetscOptionsReal("-nep_nleigs_interpolation_tol","Tolerance for interpolation via divided differences","NEPNLEIGSSetInterpolation",r,&r,&flg2);
1879:     if (flg1 || flg2) { NEPNLEIGSSetInterpolation(nep,r,i); }

1881:     k = SHIFTMAX;
1882:     for (i=0;i<k;i++) array[i] = 0;
1883:     PetscOptionsScalarArray("-nep_nleigs_rk_shifts","Shifts for Rational Krylov","NEPNLEIGSSetRKShifts",array,&k,&flg1);
1884:     if (flg1) { NEPNLEIGSSetRKShifts(nep,k,array); }

1886:   PetscOptionsTail();

1888:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->ksp); }
1889:   for (i=0;i<ctx->nshiftsw;i++) {
1890:     KSPGetPC(ctx->ksp[i],&pc);
1891:     KSPGetType(ctx->ksp[i],&ksptype);
1892:     PCGetType(pc,&pctype);
1893:     if (!pctype && !ksptype) {
1894:       KSPSetType(ctx->ksp[i],KSPPREONLY);
1895:       PCSetType(pc,PCLU);
1896:     }
1897:     KSPSetFromOptions(ctx->ksp[i]);
1898:   }
1899:   return(0);
1900: }

1902: static PetscErrorCode NEPNLEIGSGetKSPs_NLEIGS(NEP nep,KSP **ksp)
1903: {
1905:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
1906:   PetscInt       i;

1909:   if (!ctx->ksp) {
1910:     NEPNLEIGSSetShifts(nep);
1911:     PetscMalloc1(ctx->nshiftsw,&ctx->ksp);
1912:     for (i=0;i<ctx->nshiftsw;i++) {
1913:       KSPCreate(PetscObjectComm((PetscObject)nep),&ctx->ksp[i]);
1914:       KSPSetOptionsPrefix(ctx->ksp[i],((PetscObject)nep)->prefix);
1915:       KSPAppendOptionsPrefix(ctx->ksp[i],"nep_nleigs_");
1916:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)nep,1);
1917:       PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->ksp[i]);
1918:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
1919:       KSPSetTolerances(ctx->ksp[i],SLEPC_DEFAULT_TOL,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
1920:     }
1921:   }
1922:   *ksp = ctx->ksp;
1923:   return(0);
1924: }

1926: /*@C
1927:    NEPNLEIGSGetKSPs - Retrieve the array of linear solver objects associated with
1928:    the nonlinear eigenvalue solver.

1930:    Not Collective

1932:    Input Parameter:
1933: .  nep - nonlinear eigenvalue solver

1935:    Output Parameter:
1936: .  ksp - array of linear solver object

1938:    Level: advanced
1939: @*/
1940: PetscErrorCode NEPNLEIGSGetKSPs(NEP nep,KSP **ksp)
1941: {

1947:   PetscUseMethod(nep,"NEPNLEIGSGetKSPs_C",(NEP,KSP**),(nep,ksp));
1948:   return(0);
1949: }

1951: PetscErrorCode NEPView_NLEIGS(NEP nep,PetscViewer viewer)
1952: {
1954:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
1955:   PetscBool      isascii;
1956:   PetscInt       i;
1957:   char           str[50];

1960:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
1961:   if (isascii) {
1962:     PetscViewerASCIIPrintf(viewer,"  %d%% of basis vectors kept after restart\n",(int)(100*ctx->keep));
1963:     PetscViewerASCIIPrintf(viewer,"  using the %slocking variant\n",ctx->lock?"":"non-");
1964:     PetscViewerASCIIPrintf(viewer,"  divided difference terms: used=%D, max=%D\n",ctx->nmat,ctx->ddmaxit);
1965:     PetscViewerASCIIPrintf(viewer,"  tolerance for divided difference convergence: %g\n",(double)ctx->ddtol);
1966:     if (ctx->nshifts) {
1967:       PetscViewerASCIIPrintf(viewer,"  RK shifts: ");
1968:       PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
1969:       for (i=0;i<ctx->nshifts;i++) {
1970:         SlepcSNPrintfScalar(str,50,ctx->shifts[i],PETSC_FALSE);
1971:         PetscViewerASCIIPrintf(viewer,"%s%s",str,(i<ctx->nshifts-1)?",":"");
1972:       }
1973:       PetscViewerASCIIPrintf(viewer,"\n");
1974:       PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
1975:     }
1976:     if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->ksp); }
1977:     PetscViewerASCIIPushTab(viewer);
1978:     KSPView(ctx->ksp[0],viewer);
1979:     PetscViewerASCIIPopTab(viewer);
1980:   }
1981:   return(0);
1982: }

1984: PetscErrorCode NEPReset_NLEIGS(NEP nep)
1985: {
1987:   PetscInt       k;
1988:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;

1991:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
1992:     PetscFree(ctx->coeffD);
1993:   } else {
1994:     for (k=0;k<ctx->nmat;k++) { MatDestroy(&ctx->D[k]); }
1995:   }
1996:   PetscFree4(ctx->s,ctx->xi,ctx->beta,ctx->D);
1997:   for (k=0;k<ctx->nshiftsw;k++) { KSPReset(ctx->ksp[k]); }
1998:   if (ctx->vrn) {
1999:     VecDestroy(&ctx->vrn);
2000:   }
2001:   return(0);
2002: }

2004: PetscErrorCode NEPDestroy_NLEIGS(NEP nep)
2005: {
2007:   PetscInt       k;
2008:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

2011:   for (k=0;k<ctx->nshiftsw;k++) { KSPDestroy(&ctx->ksp[k]); }
2012:   PetscFree(ctx->ksp);
2013:   if (ctx->nshifts) { PetscFree(ctx->shifts); }
2014:   PetscFree(nep->data);
2015:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetSingularitiesFunction_C",NULL);
2016:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetSingularitiesFunction_C",NULL);
2017:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRestart_C",NULL);
2018:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRestart_C",NULL);
2019:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetLocking_C",NULL);
2020:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetLocking_C",NULL);
2021:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetInterpolation_C",NULL);
2022:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetInterpolation_C",NULL);
2023:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRKShifts_C",NULL);
2024:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRKShifts_C",NULL);
2025:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetKSPs_C",NULL);
2026:   return(0);
2027: }

2029: PETSC_EXTERN PetscErrorCode NEPCreate_NLEIGS(NEP nep)
2030: {
2032:   NEP_NLEIGS     *ctx;

2035:   PetscNewLog(nep,&ctx);
2036:   nep->data  = (void*)ctx;
2037:   ctx->lock  = PETSC_TRUE;
2038:   ctx->ddtol = PETSC_DEFAULT;

2040:   nep->ops->solve          = NEPSolve_NLEIGS;
2041:   nep->ops->setup          = NEPSetUp_NLEIGS;
2042:   nep->ops->setfromoptions = NEPSetFromOptions_NLEIGS;
2043:   nep->ops->view           = NEPView_NLEIGS;
2044:   nep->ops->destroy        = NEPDestroy_NLEIGS;
2045:   nep->ops->reset          = NEPReset_NLEIGS;
2046:   nep->ops->computevectors = NEPComputeVectors_Schur;

2048:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetSingularitiesFunction_C",NEPNLEIGSSetSingularitiesFunction_NLEIGS);
2049:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetSingularitiesFunction_C",NEPNLEIGSGetSingularitiesFunction_NLEIGS);
2050:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRestart_C",NEPNLEIGSSetRestart_NLEIGS);
2051:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRestart_C",NEPNLEIGSGetRestart_NLEIGS);
2052:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetLocking_C",NEPNLEIGSSetLocking_NLEIGS);
2053:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetLocking_C",NEPNLEIGSGetLocking_NLEIGS);
2054:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetInterpolation_C",NEPNLEIGSSetInterpolation_NLEIGS);
2055:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetInterpolation_C",NEPNLEIGSGetInterpolation_NLEIGS);
2056:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRKShifts_C",NEPNLEIGSSetRKShifts_NLEIGS);
2057:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRKShifts_C",NEPNLEIGSGetRKShifts_NLEIGS);
2058:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetKSPs_C",NEPNLEIGSGetKSPs_NLEIGS);
2059:   return(0);
2060: }