Actual source code: nleigs.c
slepc-3.8.3 2018-04-03
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: }