Date: 2020-01-13T12:01:54+00:00

Actual source code: nleigs.c
slepc-3.12.2 2020-01-13
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2019, 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>
     28: #include "nleigs.h"

     30: PetscErrorCode NEPNLEIGSBackTransform(PetscObject ob,PetscInt n,PetscScalar *valr,PetscScalar *vali)
     31: {
     32:   NEP         nep;
     33:   PetscInt    j;
     34: #if !defined(PETSC_USE_COMPLEX)
     35:   PetscScalar t;
     36: #endif

     39:   nep = (NEP)ob;
     40: #if !defined(PETSC_USE_COMPLEX)
     41:   for (j=0;j<n;j++) {
     42:     if (vali[j] == 0) valr[j] = 1.0 / valr[j] + nep->target;
     43:     else {
     44:       t = valr[j] * valr[j] + vali[j] * vali[j];
     45:       valr[j] = valr[j] / t + nep->target;
     46:       vali[j] = - vali[j] / t;
     47:     }
     48:   }
     49: #else
     50:   for (j=0;j<n;j++) {
     51:     valr[j] = 1.0 / valr[j] + nep->target;
     52:   }
     53: #endif
     54:   return(0);
     55: }

     57: /* Computes the roots of a polynomial */
     58: static PetscErrorCode NEPNLEIGSAuxiliarPRootFinder(PetscInt deg,PetscScalar *polcoeffs,PetscScalar *wr,PetscScalar *wi,PetscBool *avail)
     59: {
     61:   PetscScalar    *C,*work;
     62:   PetscBLASInt   n_,info,lwork;
     63:   PetscInt       i;
     64: #if defined(PETSC_USE_COMPLEX)
     65:   PetscReal      *rwork;
     66: #endif
     67: #if defined(PETSC_HAVE_ESSL)
     68:   PetscScalar    sdummy;
     69:   PetscBLASInt   idummy,io=0;
     70:   PetscScalar    *wri;
     71: #endif

     74: #if defined(PETSC_MISSING_LAPACK_GEEV)
     75:   *avail = PETSC_FALSE;
     76: #else
     77:   *avail = PETSC_TRUE;
     78:   if (deg>0) {
     79:     PetscCalloc1(deg*deg,&C);
     80:     PetscBLASIntCast(deg,&n_);
     81:     for (i=0;i<deg-1;i++) {
     82:       C[(deg+1)*i+1]   = 1.0;
     83:       C[(deg-1)*deg+i] = -polcoeffs[deg-i]/polcoeffs[0];
     84:     }
     85:     C[deg*deg+-1] = -polcoeffs[1]/polcoeffs[0];
     86:     PetscBLASIntCast(3*deg,&lwork);

     88:     PetscFPTrapPush(PETSC_FP_TRAP_OFF);
     89: #if !defined(PETSC_HAVE_ESSL)
     90: #if !defined(PETSC_USE_COMPLEX)
     91:     PetscMalloc1(lwork,&work);
     92:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&n_,C,&n_,wr,wi,NULL,&n_,NULL,&n_,work,&lwork,&info));
     93:     if (info) *avail = PETSC_FALSE;
     94:     PetscFree(work);
     95: #else
     96:     PetscMalloc2(2*deg,&rwork,lwork,&work);
     97:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&n_,C,&n_,wr,NULL,&n_,NULL,&n_,work,&lwork,rwork,&info));
     98:     if (info) *avail = PETSC_FALSE;
     99:     PetscFree2(rwork,work);
    100: #endif
    101: #else
    102:     PetscMalloc2(lwork,&work,2*deg,&wri);
    103:     PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_(&io,C,&n_,wri,&sdummy,&idummy,&idummy,&n_,work,&lwork));
    104: #if !defined(PETSC_USE_COMPLEX)
    105:     for (i=0;i<deg;i++) {
    106:       wr[i] = wri[2*i];
    107:       wi[i] = wri[2*i+1];
    108:     }
    109: #else
    110:     for (i=0;i<deg;i++) wr[i] = wri[i];
    111: #endif
    112:     PetscFree2(work,wri);
    113: #endif
    114:     PetscFPTrapPop();
    115:     PetscFree(C);
    116:   }
    117: #endif
    118:   return(0);
    119: }

    121: static PetscErrorCode NEPNLEIGSAuxiliarRmDuplicates(PetscInt nin,PetscScalar *pin,PetscInt *nout,PetscScalar *pout,PetscInt max)
    122: {
    123:   PetscInt i,j;

    126:   for (i=0;i<nin;i++) {
    127:     if (max && *nout>=max) break;
    128:     pout[(*nout)++] = pin[i];
    129:     for (j=0;j<*nout-1;j++)
    130:       if (PetscAbsScalar(pin[i]-pout[j])<PETSC_MACHINE_EPSILON*100) {
    131:         (*nout)--;
    132:         break;
    133:       }
    134:   }
    135:   return(0);
    136: }

    138: static PetscErrorCode NEPNLEIGSFNSingularities(FN f,PetscInt *nisol,PetscScalar **isol,PetscBool *rational)
    139: {
    141:   FNCombineType  ctype;
    142:   FN             f1,f2;
    143:   PetscInt       i,nq,nisol1,nisol2;
    144:   PetscScalar    *qcoeff,*wr,*wi,*isol1,*isol2;
    145:   PetscBool      flg,avail,rat1,rat2;

    148:   *rational = PETSC_FALSE;
    149:   PetscObjectTypeCompare((PetscObject)f,FNRATIONAL,&flg);
    150:   if (flg) {
    151:     *rational = PETSC_TRUE;
    152:     FNRationalGetDenominator(f,&nq,&qcoeff);
    153:     if (nq>1) {
    154:       PetscMalloc2(nq-1,&wr,nq-1,&wi);
    155:       NEPNLEIGSAuxiliarPRootFinder(nq-1,qcoeff,wr,wi,&avail);
    156:       if (avail) {
    157:         PetscCalloc1(nq-1,isol);
    158:         *nisol = 0;
    159:         for (i=0;i<nq-1;i++)
    160: #if !defined(PETSC_USE_COMPLEX)
    161:           if (wi[i]==0)
    162: #endif
    163:             (*isol)[(*nisol)++] = wr[i];
    164:         nq = *nisol; *nisol = 0;
    165:         for (i=0;i<nq;i++) wr[i] = (*isol)[i];
    166:         NEPNLEIGSAuxiliarRmDuplicates(nq,wr,nisol,*isol,0);
    167:         PetscFree2(wr,wi);
    168:       } else { *nisol=0; *isol = NULL; }
    169:     } else { *nisol = 0; *isol = NULL; }
    170:     PetscFree(qcoeff);
    171:   }
    172:   PetscObjectTypeCompare((PetscObject)f,FNCOMBINE,&flg);
    173:   if (flg) {
    174:     FNCombineGetChildren(f,&ctype,&f1,&f2);
    175:     if (ctype != FN_COMBINE_COMPOSE && ctype != FN_COMBINE_DIVIDE) {
    176:       NEPNLEIGSFNSingularities(f1,&nisol1,&isol1,&rat1);
    177:       NEPNLEIGSFNSingularities(f2,&nisol2,&isol2,&rat2);
    178:       if (nisol1+nisol2>0) {
    179:         PetscCalloc1(nisol1+nisol2,isol);
    180:         *nisol = 0;
    181:         NEPNLEIGSAuxiliarRmDuplicates(nisol1,isol1,nisol,*isol,0);
    182:         NEPNLEIGSAuxiliarRmDuplicates(nisol2,isol2,nisol,*isol,0);
    183:       }
    184:       *rational = (rat1&&rat2)?PETSC_TRUE:PETSC_FALSE;
    185:       PetscFree(isol1);
    186:       PetscFree(isol2);
    187:     }
    188:   }
    189:   return(0);
    190: }

    192: static PetscErrorCode NEPNLEIGSRationalSingularities(NEP nep,PetscInt *ndptx,PetscScalar *dxi,PetscBool *rational)
    193: {
    195:   PetscInt       nt,i,nisol;
    196:   FN             f;
    197:   PetscScalar    *isol;
    198:   PetscBool      rat;

    201:   *rational = PETSC_TRUE;
    202:   *ndptx = 0;
    203:   NEPGetSplitOperatorInfo(nep,&nt,NULL);
    204:   for (i=0;i<nt;i++) {
    205:     NEPGetSplitOperatorTerm(nep,i,NULL,&f);
    206:     NEPNLEIGSFNSingularities(f,&nisol,&isol,&rat);
    207:     if (nisol) {
    208:       NEPNLEIGSAuxiliarRmDuplicates(nisol,isol,ndptx,dxi,0);
    209:       PetscFree(isol);
    210:     }
    211:     *rational = ((*rational)&&rat)?PETSC_TRUE:PETSC_FALSE;
    212:   }
    213:   return(0);
    214: }

    216: /*  Adaptive Anderson-Antoulas algorithm */
    217: static PetscErrorCode NEPNLEIGSAAAComputation(NEP nep,PetscInt ndpt,PetscScalar *ds,PetscScalar *F,PetscInt *ndptx,PetscScalar *dxi)
    218: {
    219: #if defined(SLEPC_MISSING_LAPACK_GGEV) || defined(PETSC_MISSING_LAPACK_GESVD)
    221:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GEEV/GESVD - Lapack routines are unavailable");
    222: #else
    224:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    225:   PetscScalar    mean=0.0,*z,*f,*C,*A,*VT,*work,*ww,szero=0.0,sone=1.0;
    226:   PetscScalar    *N,*D;
    227:   PetscReal      *S,norm,err,*R;
    228:   PetscInt       i,k,j,idx=0,cont;
    229:   PetscBLASInt   n_,m_,lda_,lwork,info,one=1;
    230: #if defined(PETSC_USE_COMPLEX)
    231:   PetscReal      *rwork;
    232: #endif

    235:   PetscBLASIntCast(8*ndpt,&lwork);
    236:   PetscMalloc5(ndpt,&R,ndpt,&z,ndpt,&f,ndpt*ndpt,&C,ndpt,&ww);
    237:   PetscMalloc6(ndpt*ndpt,&A,ndpt,&S,ndpt*ndpt,&VT,lwork,&work,ndpt,&D,ndpt,&N);
    238: #if defined(PETSC_USE_COMPLEX)
    239:   PetscMalloc1(8*ndpt,&rwork);
    240: #endif
    241:   norm = 0.0;
    242:   for (i=0;i<ndpt;i++) {
    243:     mean += F[i];
    244:     norm = PetscMax(PetscAbsScalar(F[i]),norm);
    245:   }
    246:   mean /= ndpt;
    247:   PetscBLASIntCast(ndpt,&lda_);
    248:   for (i=0;i<ndpt;i++) R[i] = PetscAbsScalar(F[i]-mean);
    249:   /* next support point */
    250:   err = 0.0;
    251:   for (i=0;i<ndpt;i++) if (R[i]>=err) {idx = i; err = R[i];}
    252:   for (k=0;k<ndpt-1;k++) {
    253:     z[k] = ds[idx]; f[k] = F[idx]; R[idx] = -1.0;
    254:     /* next column of Cauchy matrix */
    255:     for (i=0;i<ndpt;i++) {
    256:       C[i+k*ndpt] = 1.0/(ds[i]-ds[idx]);
    257:     }

    259:     PetscArrayzero(A,ndpt*ndpt);
    260:     cont = 0;
    261:     for (i=0;i<ndpt;i++) {
    262:       if (R[i]!=-1.0) {
    263:         for (j=0;j<=k;j++)A[cont+j*ndpt] = C[i+j*ndpt]*F[i]-C[i+j*ndpt]*f[j];
    264:         cont++;
    265:       }
    266:     }
    267:     PetscBLASIntCast(cont,&m_);
    268:     PetscBLASIntCast(k+1,&n_);
    269: #if defined(PETSC_USE_COMPLEX)
    270:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","A",&m_,&n_,A,&lda_,S,NULL,&lda_,VT,&lda_,work,&lwork,rwork,&info));
    271: #else
    272:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","A",&m_,&n_,A,&lda_,S,NULL,&lda_,VT,&lda_,work,&lwork,&info));
    273: #endif
    274:     SlepcCheckLapackInfo("gesvd",info);
    275:     for (i=0;i<=k;i++) {
    276:       ww[i] = PetscConj(VT[i*ndpt+k]);
    277:       D[i] = ww[i]*f[i];
    278:     }
    279:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&lda_,&n_,&sone,C,&lda_,D,&one,&szero,N,&one));
    280:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&lda_,&n_,&sone,C,&lda_,ww,&one,&szero,D,&one));
    281:     for (i=0;i<ndpt;i++) if (R[i]>=0) R[i] = PetscAbsScalar(F[i]-N[i]/D[i]);
    282:     /* next support point */
    283:     err = 0.0;
    284:     for (i=0;i<ndpt;i++) if (R[i]>=err) {idx = i; err = R[i];}
    285:     if (err <= ctx->ddtol*norm) break;
    286:   }

    288:   if (k==ndpt-1) SETERRQ(PetscObjectComm((PetscObject)nep),1,"Failed to determine singularities automatically in general problem");
    289:   /* poles */
    290:   PetscArrayzero(C,ndpt*ndpt);
    291:   PetscArrayzero(A,ndpt*ndpt);
    292:   for (i=0;i<=k;i++) {
    293:     C[i+ndpt*i] = 1.0;
    294:     A[(i+1)*ndpt] = ww[i];
    295:     A[i+1] = 1.0;
    296:     A[i+1+(i+1)*ndpt] = z[i];
    297:   }
    298:   C[0] = 0.0; C[k+1+(k+1)*ndpt] = 1.0;
    299:   n_++;
    300: #if defined(PETSC_USE_COMPLEX)
    301:   PetscStackCallBLAS("LAPACKggev",LAPACKggev_("N","N",&n_,A,&lda_,C,&lda_,D,N,NULL,&lda_,NULL,&lda_,work,&lwork,rwork,&info));
    302: #else
    303:   PetscStackCallBLAS("LAPACKggev",LAPACKggev_("N","N",&n_,A,&lda_,C,&lda_,D,VT,N,NULL,&lda_,NULL,&lda_,work,&lwork,&info));
    304: #endif
    305:   SlepcCheckLapackInfo("ggev",info);
    306:   cont = 0.0;
    307:   for (i=0;i<n_;i++) if (N[i]!=0.0) {
    308:     dxi[cont++] = D[i]/N[i];
    309:   }
    310:   *ndptx = cont;
    311:   PetscFree5(R,z,f,C,ww);
    312:   PetscFree6(A,S,VT,work,D,N);
    313: #if defined(PETSC_USE_COMPLEX)
    314:   PetscFree(rwork);
    315: #endif
    316: #endif
    317:   return(0);
    318: }

    320: /*  Singularities using Adaptive Anderson-Antoulas algorithm */
    321: static PetscErrorCode NEPNLEIGSAAASingularities(NEP nep,PetscInt ndpt,PetscScalar *ds,PetscInt *ndptx,PetscScalar *dxi)
    322: {
    324:   Vec            u,v,w;
    325:   PetscRandom    rand;
    326:   PetscScalar    *F,*isol;
    327:   PetscInt       i,k,nisol,nt;
    328:   Mat            T;
    329:   FN             f;

    332:   PetscMalloc1(ndpt,&F);
    333:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
    334:     PetscMalloc1(ndpt,&isol);
    335:     *ndptx = 0;
    336:     NEPGetSplitOperatorInfo(nep,&nt,NULL);
    337:     nisol = *ndptx;
    338:     for (k=0;k<nt;k++) {
    339:       NEPGetSplitOperatorTerm(nep,k,NULL,&f);
    340:       for (i=0;i<ndpt;i++) {
    341:         FNEvaluateFunction(f,ds[i],&F[i]);
    342:       }
    343:       NEPNLEIGSAAAComputation(nep,ndpt,ds,F,&nisol,isol);
    344:       if (nisol) {
    345:         NEPNLEIGSAuxiliarRmDuplicates(nisol,isol,ndptx,dxi,ndpt);
    346:       }
    347:     }
    348:     PetscFree(isol);
    349:   } else {
    350:     MatCreateVecs(nep->function,&u,NULL);
    351:     VecDuplicate(u,&v);
    352:     VecDuplicate(u,&w);
    353:     BVGetRandomContext(nep->V,&rand);
    354:     VecSetRandom(u,rand);
    355:     VecNormalize(u,NULL);
    356:     VecSetRandom(v,rand);
    357:     VecNormalize(v,NULL);
    358:     T = nep->function;
    359:     for (i=0;i<ndpt;i++) {
    360:       NEPComputeFunction(nep,ds[i],T,T);
    361:       MatMult(T,v,w);
    362:       VecDot(w,u,&F[i]);
    363:     }
    364:     NEPNLEIGSAAAComputation(nep,ndpt,ds,F,ndptx,dxi);
    365:     VecDestroy(&u);
    366:     VecDestroy(&v);
    367:     VecDestroy(&w);
    368:   }
    369:   PetscFree(F);
    370:   return(0);
    371: }

    373: static PetscErrorCode NEPNLEIGSLejaBagbyPoints(NEP nep)
    374: {
    376:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    377:   PetscInt       i,k,ndpt=NDPOINTS,ndptx=NDPOINTS;
    378:   PetscScalar    *ds,*dsi,*dxi,*nrs,*nrxi,*s=ctx->s,*xi=ctx->xi,*beta=ctx->beta;
    379:   PetscReal      maxnrs,minnrxi;
    380:   PetscBool      rational;
    381: #if !defined(PETSC_USE_COMPLEX)
    382:   PetscReal      a,b,h;
    383: #endif

    386:   if (!ctx->computesingularities && nep->problem_type!=NEP_RATIONAL) ndpt = ndptx = LBPOINTS;
    387:   PetscMalloc5(ndpt+1,&ds,ndpt+1,&dsi,ndpt,&dxi,ndpt+1,&nrs,ndpt,&nrxi);

    389:   /* Discretize the target region boundary */
    390:   RGComputeContour(nep->rg,ndpt,ds,dsi);
    391: #if !defined(PETSC_USE_COMPLEX)
    392:   for (i=0;i<ndpt;i++) if (dsi[i]!=0.0) break;
    393:   if (i<ndpt) {
    394:     if (nep->problem_type==NEP_RATIONAL) {
    395:       /* Select a segment in the real axis */
    396:       RGComputeBoundingBox(nep->rg,&a,&b,NULL,NULL);
    397:       if (a<=-PETSC_MAX_REAL || b>=PETSC_MAX_REAL) SETERRQ(PetscObjectComm((PetscObject)nep),1,"NLEIGS requires a bounded target set");
    398:       h = (b-a)/ndpt;
    399:       for (i=0;i<ndpt;i++) {ds[i] = a+h*i; dsi[i] = 0.0;}
    400:     } else SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"NLEIGS with real arithmetic requires the target set to be included in the real axis");
    401:   }
    402: #endif
    403:   /* Discretize the singularity region */
    404:   if (ctx->computesingularities) {
    405:     (ctx->computesingularities)(nep,&ndptx,dxi,ctx->singularitiesctx);
    406:   } else {
    407:     if (nep->problem_type==NEP_RATIONAL) {
    408:       NEPNLEIGSRationalSingularities(nep,&ndptx,dxi,&rational);
    409:       if (!rational) SETERRQ(PetscObjectComm((PetscObject)nep),1,"Failed to determine singularities automatically in rational problem; consider solving the problem as general");
    410:     } else {
    411:       /* AAA algorithm */
    412:       NEPNLEIGSAAASingularities(nep,ndpt,ds,&ndptx,dxi);
    413:     }
    414:   }
    415:   /* Look for Leja-Bagby points in the discretization sets */
    416:   s[0]    = ds[0];
    417:   xi[0]   = (ndptx>0)?dxi[0]:PETSC_INFINITY;
    418:   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]));
    419:   beta[0] = 1.0; /* scaling factors are also computed here */
    420:   for (i=0;i<ndpt;i++) {
    421:     nrs[i] = 1.0;
    422:     nrxi[i] = 1.0;
    423:   }
    424:   for (k=1;k<ctx->ddmaxit;k++) {
    425:     maxnrs = 0.0;
    426:     minnrxi = PETSC_MAX_REAL;
    427:     for (i=0;i<ndpt;i++) {
    428:       nrs[i] *= ((ds[i]-s[k-1])/(1.0-ds[i]/xi[k-1]))/beta[k-1];
    429:       if (PetscAbsScalar(nrs[i])>maxnrs) {maxnrs = PetscAbsScalar(nrs[i]); s[k] = ds[i];}
    430:     }
    431:     if (ndptx>k) {
    432:       for (i=1;i<ndptx;i++) {
    433:         nrxi[i] *= ((dxi[i]-s[k-1])/(1.0-dxi[i]/xi[k-1]))/beta[k-1];
    434:         if (PetscAbsScalar(nrxi[i])<minnrxi) {minnrxi = PetscAbsScalar(nrxi[i]); xi[k] = dxi[i];}
    435:       }
    436:       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]));
    437:     } else xi[k] = PETSC_INFINITY;
    438:     beta[k] = maxnrs;
    439:   }
    440:   PetscFree5(ds,dsi,dxi,nrs,nrxi);
    441:   return(0);
    442: }

    444: PetscErrorCode NEPNLEIGSEvalNRTFunct(NEP nep,PetscInt k,PetscScalar sigma,PetscScalar *b)
    445: {
    446:   NEP_NLEIGS  *ctx=(NEP_NLEIGS*)nep->data;
    447:   PetscInt    i;
    448:   PetscScalar *beta=ctx->beta,*s=ctx->s,*xi=ctx->xi;

    451:   b[0] = 1.0/beta[0];
    452:   for (i=0;i<k;i++) {
    453:     b[i+1] = ((sigma-s[i])*b[i])/(beta[i+1]*(1.0-sigma/xi[i]));
    454:   }
    455:   return(0);
    456: }

    458: static PetscErrorCode MatMult_Fun(Mat A,Vec x,Vec y)
    459: {
    461:   ShellMatCtx    *ctx;
    462:   PetscInt       i;

    465:   MatShellGetContext(A,(void**)&ctx);
    466:   MatMult(ctx->A[0],x,y);
    467:   if (ctx->coeff[0]!=1.0) { VecScale(y,ctx->coeff[0]); }
    468:   for (i=1;i<ctx->nmat;i++) {
    469:     MatMult(ctx->A[i],x,ctx->t);
    470:     VecAXPY(y,ctx->coeff[i],ctx->t);
    471:   }
    472:   return(0);
    473: }

    475: static PetscErrorCode MatMultTranspose_Fun(Mat A,Vec x,Vec y)
    476: {
    478:   ShellMatCtx    *ctx;
    479:   PetscInt       i;

    482:   MatShellGetContext(A,(void**)&ctx);
    483:   MatMultTranspose(ctx->A[0],x,y);
    484:   if (ctx->coeff[0]!=1.0) { VecScale(y,ctx->coeff[0]); }
    485:   for (i=1;i<ctx->nmat;i++) {
    486:     MatMultTranspose(ctx->A[i],x,ctx->t);
    487:     VecAXPY(y,ctx->coeff[i],ctx->t);
    488:   }
    489:   return(0);
    490: }

    492: static PetscErrorCode MatGetDiagonal_Fun(Mat A,Vec diag)
    493: {
    495:   ShellMatCtx    *ctx;
    496:   PetscInt       i;

    499:   MatShellGetContext(A,(void**)&ctx);
    500:   MatGetDiagonal(ctx->A[0],diag);
    501:   if (ctx->coeff[0]!=1.0) { VecScale(diag,ctx->coeff[0]); }
    502:   for (i=1;i<ctx->nmat;i++) {
    503:     MatGetDiagonal(ctx->A[i],ctx->t);
    504:     VecAXPY(diag,ctx->coeff[i],ctx->t);
    505:   }
    506:   return(0);
    507: }

    509: static PetscErrorCode MatDuplicate_Fun(Mat A,MatDuplicateOption op,Mat *B)
    510: {
    511:   PetscInt       n,i;
    512:   ShellMatCtx    *ctxnew,*ctx;
    513:   void           (*fun)(void);

    517:   MatShellGetContext(A,(void**)&ctx);
    518:   PetscNew(&ctxnew);
    519:   ctxnew->nmat = ctx->nmat;
    520:   ctxnew->maxnmat = ctx->maxnmat;
    521:   PetscMalloc2(ctxnew->maxnmat,&ctxnew->A,ctxnew->maxnmat,&ctxnew->coeff);
    522:   for (i=0;i<ctx->nmat;i++) {
    523:     PetscObjectReference((PetscObject)ctx->A[i]);
    524:     ctxnew->A[i] = ctx->A[i];
    525:     ctxnew->coeff[i] = ctx->coeff[i];
    526:   }
    527:   MatGetSize(ctx->A[0],&n,NULL);
    528:   VecDuplicate(ctx->t,&ctxnew->t);
    529:   MatCreateShell(PetscObjectComm((PetscObject)A),n,n,n,n,(void*)ctxnew,B);
    530:   MatShellSetManageScalingShifts(*B);
    531:   MatShellGetOperation(A,MATOP_MULT,&fun);
    532:   MatShellSetOperation(*B,MATOP_MULT,fun);
    533:   MatShellGetOperation(A,MATOP_MULT_TRANSPOSE,&fun);
    534:   MatShellSetOperation(*B,MATOP_MULT_TRANSPOSE,fun);
    535:   MatShellGetOperation(A,MATOP_GET_DIAGONAL,&fun);
    536:   MatShellSetOperation(*B,MATOP_GET_DIAGONAL,fun);
    537:   MatShellGetOperation(A,MATOP_DUPLICATE,&fun);
    538:   MatShellSetOperation(*B,MATOP_DUPLICATE,fun);
    539:   MatShellGetOperation(A,MATOP_DESTROY,&fun);
    540:   MatShellSetOperation(*B,MATOP_DESTROY,fun);
    541:   MatShellGetOperation(A,MATOP_AXPY,&fun);
    542:   MatShellSetOperation(*B,MATOP_AXPY,fun);
    543:   return(0);
    544: }

    546: static PetscErrorCode MatDestroy_Fun(Mat A)
    547: {
    548:   ShellMatCtx    *ctx;
    550:   PetscInt       i;

    553:   if (A) {
    554:     MatShellGetContext(A,(void**)&ctx);
    555:     for (i=0;i<ctx->nmat;i++) {
    556:       MatDestroy(&ctx->A[i]);
    557:     }
    558:     VecDestroy(&ctx->t);
    559:     PetscFree2(ctx->A,ctx->coeff);
    560:     PetscFree(ctx);
    561:   }
    562:   return(0);
    563: }

    565: static PetscErrorCode MatAXPY_Fun(Mat Y,PetscScalar a,Mat X,MatStructure str)
    566: {
    567:   ShellMatCtx    *ctxY,*ctxX;
    569:   PetscInt       i,j;
    570:   PetscBool      found;

    573:   MatShellGetContext(Y,(void**)&ctxY);
    574:   MatShellGetContext(X,(void**)&ctxX);
    575:   for (i=0;i<ctxX->nmat;i++) {
    576:     found = PETSC_FALSE;
    577:     for (j=0;!found&&j<ctxY->nmat;j++) {
    578:       if (ctxX->A[i]==ctxY->A[j]) {
    579:         found = PETSC_TRUE;
    580:         ctxY->coeff[j] += a*ctxX->coeff[i];
    581:       }
    582:     }
    583:     if (!found) {
    584:       ctxY->coeff[ctxY->nmat] = a*ctxX->coeff[i];
    585:       ctxY->A[ctxY->nmat++] = ctxX->A[i];
    586:       PetscObjectReference((PetscObject)ctxX->A[i]);
    587:     }
    588:   }
    589:   return(0);
    590: }

    592: static PetscErrorCode MatScale_Fun(Mat M,PetscScalar a)
    593: {
    594:   ShellMatCtx    *ctx;
    596:   PetscInt       i;

    599:   MatShellGetContext(M,(void**)&ctx);
    600:   for (i=0;i<ctx->nmat;i++) ctx->coeff[i] *= a;
    601:   return(0);
    602: }

    604: static PetscErrorCode NLEIGSMatToMatShellArray(Mat M,Mat *Ms,PetscInt maxnmat)
    605: {
    607:   ShellMatCtx    *ctx;
    608:   PetscInt       n;
    609:   PetscBool      has;

    612:   MatHasOperation(M,MATOP_DUPLICATE,&has);
    613:   if (!has) SETERRQ(PetscObjectComm((PetscObject)M),1,"MatDuplicate operation required");
    614:   PetscNew(&ctx);
    615:   ctx->maxnmat = maxnmat;
    616:   PetscMalloc2(ctx->maxnmat,&ctx->A,ctx->maxnmat,&ctx->coeff);
    617:   MatDuplicate(M,MAT_COPY_VALUES,&ctx->A[0]);
    618:   ctx->nmat = 1;
    619:   ctx->coeff[0] = 1.0;
    620:   MatCreateVecs(M,&ctx->t,NULL);
    621:   MatGetSize(M,&n,NULL);
    622:   MatCreateShell(PetscObjectComm((PetscObject)M),n,n,n,n,(void*)ctx,Ms);
    623:   MatShellSetManageScalingShifts(*Ms);
    624:   MatShellSetOperation(*Ms,MATOP_MULT,(void(*)(void))MatMult_Fun);
    625:   MatShellSetOperation(*Ms,MATOP_MULT_TRANSPOSE,(void(*)(void))MatMultTranspose_Fun);
    626:   MatShellSetOperation(*Ms,MATOP_GET_DIAGONAL,(void(*)(void))MatGetDiagonal_Fun);
    627:   MatShellSetOperation(*Ms,MATOP_DUPLICATE,(void(*)(void))MatDuplicate_Fun);
    628:   MatShellSetOperation(*Ms,MATOP_DESTROY,(void(*)(void))MatDestroy_Fun);
    629:   MatShellSetOperation(*Ms,MATOP_AXPY,(void(*)(void))MatAXPY_Fun);
    630:   MatShellSetOperation(*Ms,MATOP_SCALE,(void(*)(void))MatScale_Fun);
    631:   return(0);
    632: }

    634: static PetscErrorCode NEPNLEIGSNormEstimation(NEP nep,Mat M,PetscReal *norm,Vec *w)
    635: {
    636:   PetscScalar    *z,*x,*y;
    637:   PetscReal      tr;
    638:   Vec            X=w[0],Y=w[1];
    639:   PetscInt       n,i;
    640:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    641:   PetscRandom    rand;

    645:   if (!ctx->vrn) {
    646:     /* generate a random vector with normally distributed entries with the Box-Muller transform */
    647:     BVGetRandomContext(nep->V,&rand);
    648:     MatCreateVecs(M,&ctx->vrn,NULL);
    649:     VecSetRandom(X,rand);
    650:     VecSetRandom(Y,rand);
    651:     VecGetLocalSize(ctx->vrn,&n);
    652:     VecGetArray(ctx->vrn,&z);
    653:     VecGetArray(X,&x);
    654:     VecGetArray(Y,&y);
    655:     for (i=0;i<n;i++) {
    656: #if defined(PETSC_USE_COMPLEX)
    657:       z[i] = PetscCMPLX(PetscSqrtReal(-2.0*PetscLogReal(PetscRealPart(x[i])))*PetscCosReal(2.0*PETSC_PI*PetscRealPart(y[i])),PetscSqrtReal(-2.0*PetscLogReal(PetscImaginaryPart(x[i])))*PetscCosReal(2.0*PETSC_PI*PetscImaginaryPart(y[i])));
    658: #else
    659:       z[i] = PetscSqrtReal(-2.0*PetscLogReal(x[i]))*PetscCosReal(2.0*PETSC_PI*y[i]);
    660: #endif
    661:     }
    662:     VecRestoreArray(ctx->vrn,&z);
    663:     VecRestoreArray(X,&x);
    664:     VecRestoreArray(Y,&y);
    665:     VecNorm(ctx->vrn,NORM_2,&tr);
    666:     VecScale(ctx->vrn,1/tr);
    667:   }
    668:   /* matrix-free norm estimator of Ipsen https://ipsen.math.ncsu.edu/ps/slides_ima.pdf */
    669:   MatGetSize(M,&n,NULL);
    670:   MatMult(M,ctx->vrn,X);
    671:   VecNorm(X,NORM_2,norm);
    672:   *norm *= PetscSqrtReal((PetscReal)n);
    673:   return(0);
    674: }

    676: static PetscErrorCode NEPNLEIGSDividedDifferences_split(NEP nep)
    677: {
    679:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    680:   PetscInt       k,j,i,maxnmat,nmax;
    681:   PetscReal      norm0,norm,*matnorm;
    682:   PetscScalar    *s=ctx->s,*beta=ctx->beta,*xi=ctx->xi,*b,alpha,*coeffs,*pK,*pH,sone=1.0;
    683:   Mat            T,Ts,K,H;
    684:   PetscBool      shell,hasmnorm=PETSC_FALSE,matrix=PETSC_TRUE;
    685:   PetscBLASInt   n_;

    688:   nmax = ctx->ddmaxit;
    689:   PetscMalloc1(nep->nt*nmax,&ctx->coeffD);
    690:   PetscMalloc3(nmax+1,&b,nmax+1,&coeffs,nep->nt,&matnorm);
    691:   for (j=0;j<nep->nt;j++) {
    692:     MatHasOperation(nep->A[j],MATOP_NORM,&hasmnorm);
    693:     if (!hasmnorm) break;
    694:     MatNorm(nep->A[j],NORM_INFINITY,matnorm+j);
    695:   }
    696:   /* Try matrix functions scheme */
    697:   PetscCalloc2(nmax*nmax,&pK,nmax*nmax,&pH);
    698:   for (i=0;i<nmax-1;i++) {
    699:     pK[(nmax+1)*i]   = 1.0;
    700:     pK[(nmax+1)*i+1] = beta[i+1]/xi[i];
    701:     pH[(nmax+1)*i]   = s[i];
    702:     pH[(nmax+1)*i+1] = beta[i+1];
    703:   }
    704:   pH[nmax*nmax-1] = s[nmax-1];
    705:   pK[nmax*nmax-1] = 1.0;
    706:   PetscBLASIntCast(nmax,&n_);
    707:   PetscStackCallBLAS("BLAStrsm",BLAStrsm_("R","L","N","U",&n_,&n_,&sone,pK,&n_,pH,&n_));
    708:   /* The matrix to be used is in H. K will be a work-space matrix */
    709:   MatCreateSeqDense(PETSC_COMM_SELF,nmax,nmax,pH,&H);
    710:   MatCreateSeqDense(PETSC_COMM_SELF,nmax,nmax,pK,&K);
    711:   for (j=0;matrix&&j<nep->nt;j++) {
    712:     PetscPushErrorHandler(PetscIgnoreErrorHandler,NULL);
    713:     FNEvaluateFunctionMat(nep->f[j],H,K);
    714:     PetscPopErrorHandler();
    715:     if (!ierr) {
    716:       for (i=0;i<nmax;i++) { ctx->coeffD[j+i*nep->nt] = pK[i]*beta[0]; }
    717:     } else {
    718:       matrix = PETSC_FALSE;
    719:       PetscFPTrapPop();
    720:     }
    721:   }
    722:   MatDestroy(&H);
    723:   MatDestroy(&K);
    724:   if (!matrix) {
    725:     for (j=0;j<nep->nt;j++) {
    726:       FNEvaluateFunction(nep->f[j],s[0],ctx->coeffD+j);
    727:       ctx->coeffD[j] *= beta[0];
    728:     }
    729:   }
    730:   if (hasmnorm) {
    731:     norm0 = 0.0;
    732:     for (j=0;j<nep->nt;j++) norm0 += matnorm[j]*PetscAbsScalar(ctx->coeffD[j]);
    733:   } else {
    734:     norm0 = 0.0;
    735:     for (j=0;j<nep->nt;j++) norm0 = PetscMax(PetscAbsScalar(ctx->coeffD[j]),norm0);
    736:   }
    737:   ctx->nmat = ctx->ddmaxit;
    738:   for (k=1;k<ctx->ddmaxit;k++) {
    739:     if (!matrix) {
    740:       NEPNLEIGSEvalNRTFunct(nep,k,s[k],b);
    741:       for (i=0;i<nep->nt;i++) {
    742:         FNEvaluateFunction(nep->f[i],s[k],ctx->coeffD+k*nep->nt+i);
    743:         for (j=0;j<k;j++) {
    744:           ctx->coeffD[k*nep->nt+i] -= b[j]*ctx->coeffD[i+nep->nt*j];
    745:         }
    746:         ctx->coeffD[k*nep->nt+i] /= b[k];
    747:       }
    748:     }
    749:     if (hasmnorm) {
    750:       norm = 0.0;
    751:       for (j=0;j<nep->nt;j++) norm += matnorm[j]*PetscAbsScalar(ctx->coeffD[k*nep->nt+j]);
    752:     } else {
    753:       norm = 0.0;
    754:       for (j=0;j<nep->nt;j++) norm = PetscMax(PetscAbsScalar(ctx->coeffD[k*nep->nt+j]),norm);
    755:     }
    756:     if (k>1 && norm/norm0 < ctx->ddtol) {
    757:       ctx->nmat = k+1;
    758:       break;
    759:     }
    760:   }
    761:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->nshiftsw,&ctx->ksp); }
    762:   PetscObjectTypeCompare((PetscObject)nep->A[0],MATSHELL,&shell);
    763:   maxnmat = PetscMax(ctx->ddmaxit,nep->nt);
    764:   for (i=0;i<ctx->nshiftsw;i++) {
    765:     NEPNLEIGSEvalNRTFunct(nep,ctx->nmat-1,ctx->shifts[i],coeffs);
    766:     if (!shell) {
    767:       MatDuplicate(nep->A[0],MAT_COPY_VALUES,&T);
    768:     } else {
    769:       NLEIGSMatToMatShellArray(nep->A[0],&T,maxnmat);
    770:     }
    771:     alpha = 0.0;
    772:     for (j=0;j<ctx->nmat;j++) alpha += coeffs[j]*ctx->coeffD[j*nep->nt];
    773:     MatScale(T,alpha);
    774:     for (k=1;k<nep->nt;k++) {
    775:       alpha = 0.0;
    776:       for (j=0;j<ctx->nmat;j++) alpha += coeffs[j]*ctx->coeffD[j*nep->nt+k];
    777:       if (shell) {
    778:         NLEIGSMatToMatShellArray(nep->A[k],&Ts,maxnmat);
    779:       }
    780:       MatAXPY(T,alpha,shell?Ts:nep->A[k],nep->mstr);
    781:       if (shell) {
    782:         MatDestroy(&Ts);
    783:       }
    784:     }
    785:     KSPSetOperators(ctx->ksp[i],T,T);
    786:     KSPSetUp(ctx->ksp[i]);
    787:     MatDestroy(&T);
    788:   }
    789:   PetscFree3(b,coeffs,matnorm);
    790:   PetscFree2(pK,pH);
    791:   return(0);
    792: }

    794: static PetscErrorCode NEPNLEIGSDividedDifferences_callback(NEP nep)
    795: {
    797:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    798:   PetscInt       k,j,i,maxnmat;
    799:   PetscReal      norm0,norm;
    800:   PetscScalar    *s=ctx->s,*beta=ctx->beta,*b,*coeffs;
    801:   Mat            *D=ctx->D,T;
    802:   PetscBool      shell,has,vec=PETSC_FALSE;
    803:   Vec            w[2];

    806:   PetscMalloc2(ctx->ddmaxit+1,&b,ctx->ddmaxit+1,&coeffs);
    807:   T = nep->function;
    808:   NEPComputeFunction(nep,s[0],T,T);
    809:   PetscObjectTypeCompare((PetscObject)T,MATSHELL,&shell);
    810:   maxnmat = PetscMax(ctx->ddmaxit,nep->nt);
    811:   if (!shell) {
    812:     MatDuplicate(T,MAT_COPY_VALUES,&D[0]);
    813:   } else {
    814:     NLEIGSMatToMatShellArray(T,&D[0],maxnmat);
    815:   }
    816:   if (beta[0]!=1.0) {
    817:     MatScale(D[0],1.0/beta[0]);
    818:   }
    819:   MatHasOperation(D[0],MATOP_NORM,&has);
    820:   if (has) {
    821:     MatNorm(D[0],NORM_FROBENIUS,&norm0);
    822:   } else {
    823:     MatCreateVecs(D[0],NULL,&w[0]);
    824:     VecDuplicate(w[0],&w[1]);
    825:     vec = PETSC_TRUE;
    826:     NEPNLEIGSNormEstimation(nep,D[0],&norm0,w);
    827:   }
    828:   ctx->nmat = ctx->ddmaxit;
    829:   for (k=1;k<ctx->ddmaxit;k++) {
    830:     NEPNLEIGSEvalNRTFunct(nep,k,s[k],b);
    831:     NEPComputeFunction(nep,s[k],T,T);
    832:     if (!shell) {
    833:       MatDuplicate(T,MAT_COPY_VALUES,&D[k]);
    834:     } else {
    835:       NLEIGSMatToMatShellArray(T,&D[k],maxnmat);
    836:     }
    837:     for (j=0;j<k;j++) {
    838:       MatAXPY(D[k],-b[j],D[j],nep->mstr);
    839:     }
    840:     MatScale(D[k],1.0/b[k]);
    841:     MatHasOperation(D[k],MATOP_NORM,&has);
    842:     if (has) {
    843:       MatNorm(D[k],NORM_FROBENIUS,&norm);
    844:     } else {
    845:       if (!vec) {
    846:         MatCreateVecs(D[k],NULL,&w[0]);
    847:         VecDuplicate(w[0],&w[1]);
    848:         vec = PETSC_TRUE;
    849:       }
    850:       NEPNLEIGSNormEstimation(nep,D[k],&norm,w);
    851:     }
    852:     if (k>1 && norm/norm0 < ctx->ddtol && k>1) {
    853:       ctx->nmat = k+1;
    854:       break;
    855:     }
    856:   }
    857:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->nshiftsw,&ctx->ksp); }
    858:   for (i=0;i<ctx->nshiftsw;i++) {
    859:     NEPNLEIGSEvalNRTFunct(nep,ctx->nmat-1,ctx->shifts[i],coeffs);
    860:     MatDuplicate(ctx->D[0],MAT_COPY_VALUES,&T);
    861:     if (coeffs[0]!=1.0) { MatScale(T,coeffs[0]); }
    862:     for (j=1;j<ctx->nmat;j++) {
    863:       MatAXPY(T,coeffs[j],ctx->D[j],nep->mstr);
    864:     }
    865:     KSPSetOperators(ctx->ksp[i],T,T);
    866:     KSPSetUp(ctx->ksp[i]);
    867:     MatDestroy(&T);
    868:   }
    869:   PetscFree2(b,coeffs);
    870:   if (vec) {
    871:     VecDestroy(&w[0]);
    872:     VecDestroy(&w[1]);
    873:   }
    874:   return(0);
    875: }

    877: /*
    878:    NEPKrylovConvergence - This is the analogue to EPSKrylovConvergence.
    879: */
    880: PetscErrorCode NEPNLEIGSKrylovConvergence(NEP nep,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal betah,PetscScalar betak,PetscInt *kout,Vec *w)
    881: {
    883:   PetscInt       k,newk,marker,inside;
    884:   PetscScalar    re,im;
    885:   PetscReal      resnorm,tt;
    886:   PetscBool      istrivial;
    887:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

    890:   RGIsTrivial(nep->rg,&istrivial);
    891:   marker = -1;
    892:   if (nep->trackall) getall = PETSC_TRUE;
    893:   for (k=kini;k<kini+nits;k++) {
    894:     /* eigenvalue */
    895:     re = nep->eigr[k];
    896:     im = nep->eigi[k];
    897:     if (!istrivial) {
    898:       if (!ctx->nshifts) {
    899:         NEPNLEIGSBackTransform((PetscObject)nep,1,&re,&im);
    900:       }
    901:       RGCheckInside(nep->rg,1,&re,&im,&inside);
    902:       if (marker==-1 && inside<0) marker = k;
    903:     }
    904:     newk = k;
    905:     DSVectors(nep->ds,DS_MAT_X,&newk,&resnorm);
    906:     tt = (ctx->nshifts)?SlepcAbsEigenvalue(betak-nep->eigr[k]*betah,nep->eigi[k]*betah):betah;
    907:     resnorm *=  PetscAbsReal(tt);
    908:     /* error estimate */
    909:     (*nep->converged)(nep,nep->eigr[k],nep->eigi[k],resnorm,&nep->errest[k],nep->convergedctx);
    910:     if (marker==-1 && nep->errest[k] >= nep->tol) marker = k;
    911:     if (newk==k+1) {
    912:       nep->errest[k+1] = nep->errest[k];
    913:       k++;
    914:     }
    915:     if (marker!=-1 && !getall) break;
    916:   }
    917:   if (marker!=-1) k = marker;
    918:   *kout = k;
    919:   return(0);
    920: }

    922: PetscErrorCode NEPSetUp_NLEIGS(NEP nep)
    923: {
    925:   PetscInt       k,in;
    926:   PetscScalar    zero=0.0;
    927:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    928:   SlepcSC        sc;
    929:   PetscBool      istrivial;

    932:   NEPSetDimensions_Default(nep,nep->nev,&nep->ncv,&nep->mpd);
    933:   if (nep->ncv>nep->nev+nep->mpd) SETERRQ(PetscObjectComm((PetscObject)nep),1,"The value of ncv must not be larger than nev+mpd");
    934:   if (!nep->max_it) nep->max_it = PetscMax(5000,2*nep->n/nep->ncv);
    935:   if (!ctx->ddmaxit) ctx->ddmaxit = LBPOINTS;
    936:   RGIsTrivial(nep->rg,&istrivial);
    937:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"NEPNLEIGS requires a nontrivial region defining the target set");
    938:   if (!nep->which) nep->which = NEP_TARGET_MAGNITUDE;
    939:   if (nep->which!=NEP_TARGET_MAGNITUDE && nep->which!=NEP_TARGET_REAL && nep->which!=NEP_TARGET_IMAGINARY && nep->which!=NEP_WHICH_USER) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"Should set a target selection in NEPSetWhichEigenvalues()");

    941:   /* Initialize the NLEIGS context structure */
    942:   k = ctx->ddmaxit;
    943:   PetscMalloc4(k,&ctx->s,k,&ctx->xi,k,&ctx->beta,k,&ctx->D);
    944:   nep->data = ctx;
    945:   if (nep->tol==PETSC_DEFAULT) nep->tol = SLEPC_DEFAULT_TOL;
    946:   if (ctx->ddtol==PETSC_DEFAULT) ctx->ddtol = nep->tol/10.0;
    947:   if (!ctx->keep) ctx->keep = 0.5;

    949:   /* Compute Leja-Bagby points and scaling values */
    950:   NEPNLEIGSLejaBagbyPoints(nep);
    951:   if (nep->problem_type!=NEP_RATIONAL) {
    952:     RGCheckInside(nep->rg,1,&nep->target,&zero,&in);
    953:     if (in<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"The target is not inside the target set");
    954:   }

    956:   /* Compute the divided difference matrices */
    957:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
    958:     NEPNLEIGSDividedDifferences_split(nep);
    959:   } else {
    960:     NEPNLEIGSDividedDifferences_callback(nep);
    961:   }
    962:   NEPAllocateSolution(nep,ctx->nmat-1);
    963:   NEPSetWorkVecs(nep,4);
    964:   if (!ctx->fullbasis) {
    965:     if (nep->twosided) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_SUP,"Two-sided variant requires the full-basis option, rerun with -nep_nleigs_full_basis");
    966:     /* set-up DS and transfer split operator functions */
    967:     DSSetType(nep->ds,ctx->nshifts?DSGNHEP:DSNHEP);
    968:     DSAllocate(nep->ds,nep->ncv+1);
    969:     DSGetSlepcSC(nep->ds,&sc);
    970:     if (!ctx->nshifts) {
    971:       sc->map = NEPNLEIGSBackTransform;
    972:       DSSetExtraRow(nep->ds,PETSC_TRUE);
    973:     }
    974:     sc->mapobj        = (PetscObject)nep;
    975:     sc->rg            = nep->rg;
    976:     sc->comparison    = nep->sc->comparison;
    977:     sc->comparisonctx = nep->sc->comparisonctx;
    978:     BVDestroy(&ctx->V);
    979:     BVCreateTensor(nep->V,ctx->nmat-1,&ctx->V);
    980:     nep->ops->solve          = NEPSolve_NLEIGS;
    981:     nep->ops->computevectors = NEPComputeVectors_Schur;
    982:   } else {
    983:     NEPSetUp_NLEIGS_FullBasis(nep);
    984:     nep->ops->solve          = NEPSolve_NLEIGS_FullBasis;
    985:     nep->ops->computevectors = NULL;
    986:   }
    987:   return(0);
    988: }

    990: /*
    991:   Extend the TOAR basis by applying the the matrix operator
    992:   over a vector which is decomposed on the TOAR way
    993:   Input:
    994:     - S,V: define the latest Arnoldi vector (nv vectors in V)
    995:   Output:
    996:     - t: new vector extending the TOAR basis
    997:     - r: temporally coefficients to compute the TOAR coefficients
    998:          for the new Arnoldi vector
    999:   Workspace: t_ (two vectors)
    1000: */
    1001: 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_)
    1002: {
    1004:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    1005:   PetscInt       deg=ctx->nmat-1,k,j;
    1006:   Vec            v=t_[0],q=t_[1],w;
    1007:   PetscScalar    *beta=ctx->beta,*s=ctx->s,*xi=ctx->xi,*coeffs,sigma;

    1010:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->nshiftsw,&ctx->ksp); }
    1011:   sigma = ctx->shifts[idxrktg];
    1012:   BVSetActiveColumns(nep->V,0,nv);
    1013:   PetscMalloc1(ctx->nmat,&coeffs);
    1014:   if (PetscAbsScalar(s[deg-2]-sigma)<100*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Breakdown in NLEIGS");
    1015:   /* i-part stored in (i-1) position */
    1016:   for (j=0;j<nv;j++) {
    1017:     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);
    1018:   }
    1019:   BVSetActiveColumns(W,0,deg);
    1020:   BVGetColumn(W,deg-1,&w);
    1021:   BVMultVec(V,1.0/beta[deg],0,w,S+(deg-1)*ls);
    1022:   BVRestoreColumn(W,deg-1,&w);
    1023:   BVGetColumn(W,deg-2,&w);
    1024:   BVMultVec(V,1.0,0.0,w,r+(deg-2)*lr);
    1025:   BVRestoreColumn(W,deg-2,&w);
    1026:   for (k=deg-2;k>0;k--) {
    1027:     if (PetscAbsScalar(s[k-1]-sigma)<100*PETSC_MACHINE_EPSILON) SETERRQ(PETSC_COMM_SELF,1,"Breakdown in NLEIGS");
    1028:     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);
    1029:     BVGetColumn(W,k-1,&w);
    1030:     BVMultVec(V,1.0,0.0,w,r+(k-1)*lr);
    1031:     BVRestoreColumn(W,k-1,&w);
    1032:   }
    1033:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
    1034:     for (j=0;j<ctx->nmat-2;j++) coeffs[j] = ctx->coeffD[nep->nt*j];
    1035:     coeffs[ctx->nmat-2] = ctx->coeffD[nep->nt*(ctx->nmat-1)];
    1036:     BVMultVec(W,1.0,0.0,v,coeffs);
    1037:     MatMult(nep->A[0],v,q);
    1038:     for (k=1;k<nep->nt;k++) {
    1039:       for (j=0;j<ctx->nmat-2;j++) coeffs[j] = ctx->coeffD[nep->nt*j+k];
    1040:       coeffs[ctx->nmat-2] = ctx->coeffD[nep->nt*(ctx->nmat-1)+k];
    1041:       BVMultVec(W,1.0,0,v,coeffs);
    1042:       MatMult(nep->A[k],v,t);
    1043:       VecAXPY(q,1.0,t);
    1044:     }
    1045:     KSPSolve(ctx->ksp[idxrktg],q,t);
    1046:     VecScale(t,-1.0);
    1047:   } else {
    1048:     for (k=0;k<deg-1;k++) {
    1049:       BVGetColumn(W,k,&w);
    1050:       MatMult(ctx->D[k],w,q);
    1051:       BVRestoreColumn(W,k,&w);
    1052:       BVInsertVec(W,k,q);
    1053:     }
    1054:     BVGetColumn(W,deg-1,&w);
    1055:     MatMult(ctx->D[deg],w,q);
    1056:     BVRestoreColumn(W,k,&w);
    1057:     BVInsertVec(W,k,q);
    1058:     for (j=0;j<ctx->nmat-1;j++) coeffs[j] = 1.0;
    1059:     BVMultVec(W,1.0,0.0,q,coeffs);
    1060:     KSPSolve(ctx->ksp[idxrktg],q,t);
    1061:     VecScale(t,-1.0);
    1062:   }
    1063:   PetscFree(coeffs);
    1064:   return(0);
    1065: }

    1067: /*
    1068:   Compute TOAR coefficients of the blocks of the new Arnoldi vector computed
    1069: */
    1070: static PetscErrorCode NEPTOARCoefficients(NEP nep,PetscScalar sigma,PetscInt nv,PetscScalar *S,PetscInt ls,PetscScalar *r,PetscInt lr,PetscScalar *x,PetscScalar *work)
    1071: {
    1073:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    1074:   PetscInt       k,j,d=ctx->nmat-1;
    1075:   PetscScalar    *t=work;

    1078:   NEPNLEIGSEvalNRTFunct(nep,d-1,sigma,t);
    1079:   for (k=0;k<d-1;k++) {
    1080:     for (j=0;j<=nv;j++) r[k*lr+j] += t[k]*x[j];
    1081:   }
    1082:   for (j=0;j<=nv;j++) r[(d-1)*lr+j] = t[d-1]*x[j];
    1083:   return(0);
    1084: }

    1086: /*
    1087:   Compute continuation vector coefficients for the Rational-Krylov run.
    1088:   dim(work) >= (end-ini)*(end-ini+1) + end+1 + 2*(end-ini+1), dim(t) = end.
    1089: */
    1090: 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)
    1091: {
    1092: #if defined(PETSC_MISSING_LAPACK_GEQRF) || defined(SLEPC_MISSING_LAPACK_LARF)
    1094:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GEQRF/LARF - Lapack routines are unavailable");
    1095: #else
    1097:   PetscScalar    *x,*W,*tau,sone=1.0,szero=0.0;
    1098:   PetscInt       i,j,n1,n,nwu=0;
    1099:   PetscBLASInt   info,n_,n1_,one=1,dim,lds_;
    1100:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

    1103:   if (!ctx->nshifts || !end) {
    1104:     t[0] = 1;
    1105:     PetscArraycpy(cont,S+end*lds,lds);
    1106:   } else {
    1107:     n   = end-ini;
    1108:     n1  = n+1;
    1109:     x   = work+nwu;
    1110:     nwu += end+1;
    1111:     tau = work+nwu;
    1112:     nwu += n;
    1113:     W   = work+nwu;
    1114:     nwu += n1*n;
    1115:     for (j=ini;j<end;j++) {
    1116:       for (i=ini;i<=end;i++) W[(j-ini)*n1+i-ini] = K[j*ld+i] -H[j*ld+i]*sigma;
    1117:     }
    1118:     PetscBLASIntCast(n,&n_);
    1119:     PetscBLASIntCast(n1,&n1_);
    1120:     PetscBLASIntCast(end+1,&dim);
    1121:     PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&n1_,&n_,W,&n1_,tau,work+nwu,&n1_,&info));
    1122:     SlepcCheckLapackInfo("geqrf",info);
    1123:     for (i=0;i<end;i++) t[i] = 0.0;
    1124:     t[end] = 1.0;
    1125:     for (j=n-1;j>=0;j--) {
    1126:       for (i=0;i<ini+j;i++) x[i] = 0.0;
    1127:       x[ini+j] = 1.0;
    1128:       for (i=j+1;i<n1;i++) x[i+ini] = W[i+n1*j];
    1129:       tau[j] = PetscConj(tau[j]);
    1130:       PetscStackCallBLAS("LAPACKlarf",LAPACKlarf_("L",&dim,&one,x,&one,tau+j,t,&dim,work+nwu));
    1131:     }
    1132:     PetscBLASIntCast(lds,&lds_);
    1133:     PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&lds_,&n1_,&sone,S,&lds_,t,&one,&szero,cont,&one));
    1134:   }
    1135:   return(0);
    1136: #endif
    1137: }

    1139: /*
    1140:   Compute a run of Arnoldi iterations
    1141: */
    1142: PetscErrorCode NEPNLEIGSTOARrun(NEP nep,PetscScalar *K,PetscScalar *H,PetscInt ldh,BV W,PetscInt k,PetscInt *M,PetscBool *breakdown,Vec *t_)
    1143: {
    1145:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
    1146:   PetscInt       i,j,m=*M,lwa,deg=ctx->nmat-1,lds,nqt,ld,l;
    1147:   Vec            t;
    1148:   PetscReal      norm;
    1149:   PetscScalar    *x,*work,*tt,sigma,*cont,*S;
    1150:   PetscBool      lindep;
    1151:   Mat            MS;

    1154:   BVTensorGetFactors(ctx->V,NULL,&MS);
    1155:   MatDenseGetArray(MS,&S);
    1156:   BVGetSizes(nep->V,NULL,NULL,&ld);
    1157:   lds = ld*deg;
    1158:   BVGetActiveColumns(nep->V,&l,&nqt);
    1159:   lwa = PetscMax(ld,deg)+(m+1)*(m+1)+4*(m+1);
    1160:   PetscMalloc4(ld,&x,lwa,&work,m+1,&tt,lds,&cont);
    1161:   BVSetActiveColumns(ctx->V,0,m);
    1162:   for (j=k;j<m;j++) {
    1163:     sigma = ctx->shifts[(++(ctx->idxrk))%ctx->nshiftsw];

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

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

    1173:     /* orthogonalize */
    1174:     BVOrthogonalizeColumn(nep->V,nqt,x,&norm,&lindep);
    1175:     if (!lindep) {
    1176:       x[nqt] = norm;
    1177:       BVScaleColumn(nep->V,nqt,1.0/norm);
    1178:       nqt++;
    1179:     } else x[nqt] = 0.0;

    1181:     NEPTOARCoefficients(nep,sigma,nqt-1,cont,ld,S+(j+1)*lds,ld,x,work);

    1183:     /* Level-2 orthogonalization */
    1184:     BVOrthogonalizeColumn(ctx->V,j+1,H+j*ldh,&norm,breakdown);
    1185:     H[j+1+ldh*j] = norm;
    1186:     if (ctx->nshifts) {
    1187:       for (i=0;i<=j;i++) K[i+ldh*j] = sigma*H[i+ldh*j] + tt[i];
    1188:       K[j+1+ldh*j] = sigma*H[j+1+ldh*j];
    1189:     }
    1190:     if (*breakdown) {
    1191:       *M = j+1;
    1192:       break;
    1193:     }
    1194:     BVScaleColumn(ctx->V,j+1,1.0/norm);
    1195:     BVSetActiveColumns(nep->V,l,nqt);
    1196:   }
    1197:   PetscFree4(x,work,tt,cont);
    1198:   MatDenseRestoreArray(MS,&S);
    1199:   BVTensorRestoreFactors(ctx->V,NULL,&MS);
    1200:   return(0);
    1201: }

    1203: PetscErrorCode NEPSolve_NLEIGS(NEP nep)
    1204: {
    1206:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
    1207:   PetscInt       i,k=0,l,nv=0,ld,lds,ldds,nq,newn;
    1208:   PetscInt       deg=ctx->nmat-1,nconv=0;
    1209:   PetscScalar    *S,*Q,*H,*pU,*K,betak=0,*eigr,*eigi;
    1210:   PetscReal      betah;
    1211:   PetscBool      falselock=PETSC_FALSE,breakdown=PETSC_FALSE;
    1212:   BV             W;
    1213:   Mat            MS,MQ,U;

    1216:   if (ctx->lock) {
    1217:     PetscOptionsGetBool(NULL,NULL,"-nep_nleigs_falselocking",&falselock,NULL);
    1218:   }

    1220:   BVGetSizes(nep->V,NULL,NULL,&ld);
    1221:   lds = deg*ld;
    1222:   DSGetLeadingDimension(nep->ds,&ldds);
    1223:   if (!ctx->nshifts) {
    1224:     PetscMalloc2(nep->ncv,&eigr,nep->ncv,&eigi);
    1225:   } else { eigr = nep->eigr; eigi = nep->eigi; }
    1226:   BVDuplicateResize(nep->V,PetscMax(nep->nt-1,ctx->nmat-1),&W);

    1229:   /* clean projected matrix (including the extra-arrow) */
    1230:   DSGetArray(nep->ds,DS_MAT_A,&H);
    1231:   PetscArrayzero(H,ldds*ldds);
    1232:   DSRestoreArray(nep->ds,DS_MAT_A,&H);
    1233:   if (ctx->nshifts) {
    1234:     DSGetArray(nep->ds,DS_MAT_B,&H);
    1235:     PetscArrayzero(H,ldds*ldds);
    1236:     DSRestoreArray(nep->ds,DS_MAT_B,&H);
    1237:   }

    1239:   /* Get the starting Arnoldi vector */
    1240:   BVTensorBuildFirstColumn(ctx->V,nep->nini);

    1242:   /* Restart loop */
    1243:   l = 0;
    1244:   while (nep->reason == NEP_CONVERGED_ITERATING) {
    1245:     nep->its++;

    1247:     /* Compute an nv-step Krylov relation */
    1248:     nv = PetscMin(nep->nconv+nep->mpd,nep->ncv);
    1249:     if (ctx->nshifts) { DSGetArray(nep->ds,DS_MAT_A,&K); }
    1250:     DSGetArray(nep->ds,ctx->nshifts?DS_MAT_B:DS_MAT_A,&H);
    1251:     NEPNLEIGSTOARrun(nep,K,H,ldds,W,nep->nconv+l,&nv,&breakdown,nep->work);
    1252:     betah = PetscAbsScalar(H[(nv-1)*ldds+nv]);
    1253:     DSRestoreArray(nep->ds,ctx->nshifts?DS_MAT_B:DS_MAT_A,&H);
    1254:     if (ctx->nshifts) {
    1255:       betak = K[(nv-1)*ldds+nv];
    1256:       DSRestoreArray(nep->ds,DS_MAT_A,&K);
    1257:     }
    1258:     DSSetDimensions(nep->ds,nv,0,nep->nconv,nep->nconv+l);
    1259:     if (l==0) {
    1260:       DSSetState(nep->ds,DS_STATE_INTERMEDIATE);
    1261:     } else {
    1262:       DSSetState(nep->ds,DS_STATE_RAW);
    1263:     }

    1265:     /* Solve projected problem */
    1266:     DSSolve(nep->ds,nep->eigr,nep->eigi);
    1267:     DSSort(nep->ds,nep->eigr,nep->eigi,NULL,NULL,NULL);
    1268:     if (!ctx->nshifts) {
    1269:       DSUpdateExtraRow(nep->ds);
    1270:     }
    1271:     DSSynchronize(nep->ds,nep->eigr,nep->eigi);

    1273:     /* Check convergence */
    1274:     NEPNLEIGSKrylovConvergence(nep,PETSC_FALSE,nep->nconv,nv-nep->nconv,betah,betak,&k,nep->work);
    1275:     (*nep->stopping)(nep,nep->its,nep->max_it,k,nep->nev,&nep->reason,nep->stoppingctx);

    1277:     /* Update l */
    1278:     if (nep->reason != NEP_CONVERGED_ITERATING || breakdown) l = 0;
    1279:     else {
    1280:       l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
    1281:       if (!breakdown) {
    1282:         /* Prepare the Rayleigh quotient for restart */
    1283:         if (!ctx->nshifts) {
    1284:           DSTruncate(nep->ds,k+l);
    1285:           DSGetDimensions(nep->ds,&newn,NULL,NULL,NULL,NULL);
    1286:           l = newn-k;
    1287:         } else {
    1288:           DSGetArray(nep->ds,DS_MAT_Q,&Q);
    1289:           DSGetArray(nep->ds,DS_MAT_B,&H);
    1290:           DSGetArray(nep->ds,DS_MAT_A,&K);
    1291:           for (i=ctx->lock?k:0;i<k+l;i++) {
    1292:             H[k+l+i*ldds] = betah*Q[nv-1+i*ldds];
    1293:             K[k+l+i*ldds] = betak*Q[nv-1+i*ldds];
    1294:           }
    1295:           DSRestoreArray(nep->ds,DS_MAT_B,&H);
    1296:           DSRestoreArray(nep->ds,DS_MAT_A,&K);
    1297:           DSRestoreArray(nep->ds,DS_MAT_Q,&Q);
    1298:         }
    1299:       }
    1300:     }
    1301:     nconv = k;
    1302:     if (!ctx->lock && nep->reason == NEP_CONVERGED_ITERATING && !breakdown) { l += k; k = 0; }

    1304:     /* Update S */
    1305:     DSGetMat(nep->ds,ctx->nshifts?DS_MAT_Z:DS_MAT_Q,&MQ);
    1306:     BVMultInPlace(ctx->V,MQ,nep->nconv,k+l);
    1307:     MatDestroy(&MQ);

    1309:     /* Copy last column of S */
    1310:     BVCopyColumn(ctx->V,nv,k+l);

    1312:     if (breakdown && nep->reason == NEP_CONVERGED_ITERATING) {
    1313:       /* Stop if breakdown */
    1314:       PetscInfo2(nep,"Breakdown (it=%D norm=%g)\n",nep->its,(double)betah);
    1315:       nep->reason = NEP_DIVERGED_BREAKDOWN;
    1316:     }
    1317:     if (nep->reason != NEP_CONVERGED_ITERATING) l--;
    1318:     /* truncate S */
    1319:     BVGetActiveColumns(nep->V,NULL,&nq);
    1320:     if (k+l+deg<=nq) {
    1321:       BVSetActiveColumns(ctx->V,nep->nconv,k+l+1);
    1322:       if (!falselock && ctx->lock) {
    1323:         BVTensorCompress(ctx->V,k-nep->nconv);
    1324:       } else {
    1325:         BVTensorCompress(ctx->V,0);
    1326:       }
    1327:     }
    1328:     nep->nconv = k;
    1329:     if (!ctx->nshifts) {
    1330:       for (i=0;i<nv;i++) { eigr[i] = nep->eigr[i]; eigi[i] = nep->eigi[i]; }
    1331:       NEPNLEIGSBackTransform((PetscObject)nep,nv,eigr,eigi);
    1332:     }
    1333:     NEPMonitor(nep,nep->its,nconv,eigr,eigi,nep->errest,nv);
    1334:   }
    1335:   nep->nconv = nconv;
    1336:   if (nep->nconv>0) {
    1337:     BVSetActiveColumns(ctx->V,0,nep->nconv);
    1338:     BVGetActiveColumns(nep->V,NULL,&nq);
    1339:     BVSetActiveColumns(nep->V,0,nq);
    1340:     if (nq>nep->nconv) {
    1341:       BVTensorCompress(ctx->V,nep->nconv);
    1342:       BVSetActiveColumns(nep->V,0,nep->nconv);
    1343:       nq = nep->nconv;
    1344:     }
    1345:     if (ctx->nshifts) {
    1346:       DSGetMat(nep->ds,DS_MAT_B,&MQ);
    1347:       BVMultInPlace(ctx->V,MQ,0,nep->nconv);
    1348:       MatDestroy(&MQ);
    1349:     }
    1350:     BVTensorGetFactors(ctx->V,NULL,&MS);
    1351:     MatDenseGetArray(MS,&S);
    1352:     PetscMalloc1(nq*nep->nconv,&pU);
    1353:     for (i=0;i<nep->nconv;i++) {
    1354:       PetscArraycpy(pU+i*nq,S+i*lds,nq);
    1355:     }
    1356:     MatDenseRestoreArray(MS,&S);
    1357:     BVTensorRestoreFactors(ctx->V,NULL,&MS);
    1358:     MatCreateSeqDense(PETSC_COMM_SELF,nq,nep->nconv,pU,&U);
    1359:     BVSetActiveColumns(nep->V,0,nq);
    1360:     BVMultInPlace(nep->V,U,0,nep->nconv);
    1361:     BVSetActiveColumns(nep->V,0,nep->nconv);
    1362:     MatDestroy(&U);
    1363:     PetscFree(pU);
    1364:     /* truncate Schur decomposition and change the state to raw so that
    1365:        DSVectors() computes eigenvectors from scratch */
    1366:     DSSetDimensions(nep->ds,nep->nconv,0,0,0);
    1367:     DSSetState(nep->ds,DS_STATE_RAW);
    1368:   }

    1370:   /* Map eigenvalues back to the original problem */
    1371:   if (!ctx->nshifts) {
    1372:     NEPNLEIGSBackTransform((PetscObject)nep,nep->nconv,nep->eigr,nep->eigi);
    1373:     PetscFree2(eigr,eigi);
    1374:   }
    1375:   BVDestroy(&W);
    1376:   return(0);
    1377: }

    1379: static PetscErrorCode NEPNLEIGSSetSingularitiesFunction_NLEIGS(NEP nep,PetscErrorCode (*fun)(NEP,PetscInt*,PetscScalar*,void*),void *ctx)
    1380: {
    1381:   NEP_NLEIGS *nepctx=(NEP_NLEIGS*)nep->data;

    1384:   if (fun) nepctx->computesingularities = fun;
    1385:   if (ctx) nepctx->singularitiesctx     = ctx;
    1386:   nep->state = NEP_STATE_INITIAL;
    1387:   return(0);
    1388: }

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

    1394:    Logically Collective on nep

    1396:    Input Parameters:
    1397: +  nep - the NEP context
    1398: .  fun - user function (if NULL then NEP retains any previously set value)
    1399: -  ctx - [optional] user-defined context for private data for the function
    1400:          (may be NULL, in which case NEP retains any previously set value)

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

    1405: +   nep   - the NEP context
    1406: .   maxnp - on input number of requested points in the discretization (can be set)
    1407: .   xi    - computed values of the discretization
    1408: -   ctx   - optional context, as set by NEPNLEIGSSetSingularitiesFunction()

    1410:    Notes:
    1411:    The user-defined function can set a smaller value of maxnp if necessary.
    1412:    It is wrong to return a larger value.

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

    1418:    Level: intermediate

    1420: .seealso: NEPNLEIGSGetSingularitiesFunction(), NEPSetProblemType()
    1421: @*/
    1422: PetscErrorCode NEPNLEIGSSetSingularitiesFunction(NEP nep,PetscErrorCode (*fun)(NEP,PetscInt*,PetscScalar*,void*),void *ctx)
    1423: {

    1428:   PetscTryMethod(nep,"NEPNLEIGSSetSingularitiesFunction_C",(NEP,PetscErrorCode(*)(NEP,PetscInt*,PetscScalar*,void*),void*),(nep,fun,ctx));
    1429:   return(0);
    1430: }

    1432: static PetscErrorCode NEPNLEIGSGetSingularitiesFunction_NLEIGS(NEP nep,PetscErrorCode (**fun)(NEP,PetscInt*,PetscScalar*,void*),void **ctx)
    1433: {
    1434:   NEP_NLEIGS *nepctx=(NEP_NLEIGS*)nep->data;

    1437:   if (fun) *fun = nepctx->computesingularities;
    1438:   if (ctx) *ctx = nepctx->singularitiesctx;
    1439:   return(0);
    1440: }

    1442: /*@C
    1443:    NEPNLEIGSGetSingularitiesFunction - Returns the Function and optionally the user
    1444:    provided context for computing a discretization of the singularity set.

    1446:    Not Collective

    1448:    Input Parameter:
    1449: .  nep - the nonlinear eigensolver context

    1451:    Output Parameters:
    1452: +  fun - location to put the function (or NULL)
    1453: -  ctx - location to stash the function context (or NULL)

    1455:    Level: advanced

    1457: .seealso: NEPNLEIGSSetSingularitiesFunction()
    1458: @*/
    1459: PetscErrorCode NEPNLEIGSGetSingularitiesFunction(NEP nep,PetscErrorCode (**fun)(NEP,PetscInt*,PetscScalar*,void*),void **ctx)
    1460: {

    1465:   PetscUseMethod(nep,"NEPNLEIGSGetSingularitiesFunction_C",(NEP,PetscErrorCode(**)(NEP,PetscInt*,PetscScalar*,void*),void**),(nep,fun,ctx));
    1466:   return(0);
    1467: }

    1469: static PetscErrorCode NEPNLEIGSSetRestart_NLEIGS(NEP nep,PetscReal keep)
    1470: {
    1471:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1474:   if (keep==PETSC_DEFAULT) ctx->keep = 0.5;
    1475:   else {
    1476:     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]");
    1477:     ctx->keep = keep;
    1478:   }
    1479:   return(0);
    1480: }

    1482: /*@
    1483:    NEPNLEIGSSetRestart - Sets the restart parameter for the NLEIGS
    1484:    method, in particular the proportion of basis vectors that must be kept
    1485:    after restart.

    1487:    Logically Collective on nep

    1489:    Input Parameters:
    1490: +  nep  - the nonlinear eigensolver context
    1491: -  keep - the number of vectors to be kept at restart

    1493:    Options Database Key:
    1494: .  -nep_nleigs_restart - Sets the restart parameter

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

    1499:    Level: advanced

    1501: .seealso: NEPNLEIGSGetRestart()
    1502: @*/
    1503: PetscErrorCode NEPNLEIGSSetRestart(NEP nep,PetscReal keep)
    1504: {

    1510:   PetscTryMethod(nep,"NEPNLEIGSSetRestart_C",(NEP,PetscReal),(nep,keep));
    1511:   return(0);
    1512: }

    1514: static PetscErrorCode NEPNLEIGSGetRestart_NLEIGS(NEP nep,PetscReal *keep)
    1515: {
    1516:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1519:   *keep = ctx->keep;
    1520:   return(0);
    1521: }

    1523: /*@
    1524:    NEPNLEIGSGetRestart - Gets the restart parameter used in the NLEIGS method.

    1526:    Not Collective

    1528:    Input Parameter:
    1529: .  nep - the nonlinear eigensolver context

    1531:    Output Parameter:
    1532: .  keep - the restart parameter

    1534:    Level: advanced

    1536: .seealso: NEPNLEIGSSetRestart()
    1537: @*/
    1538: PetscErrorCode NEPNLEIGSGetRestart(NEP nep,PetscReal *keep)
    1539: {

    1545:   PetscUseMethod(nep,"NEPNLEIGSGetRestart_C",(NEP,PetscReal*),(nep,keep));
    1546:   return(0);
    1547: }

    1549: static PetscErrorCode NEPNLEIGSSetLocking_NLEIGS(NEP nep,PetscBool lock)
    1550: {
    1551:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1554:   ctx->lock = lock;
    1555:   return(0);
    1556: }

    1558: /*@
    1559:    NEPNLEIGSSetLocking - Choose between locking and non-locking variants of
    1560:    the NLEIGS method.

    1562:    Logically Collective on nep

    1564:    Input Parameters:
    1565: +  nep  - the nonlinear eigensolver context
    1566: -  lock - true if the locking variant must be selected

    1568:    Options Database Key:
    1569: .  -nep_nleigs_locking - Sets the locking flag

    1571:    Notes:
    1572:    The default is to lock converged eigenpairs when the method restarts.
    1573:    This behaviour can be changed so that all directions are kept in the
    1574:    working subspace even if already converged to working accuracy (the
    1575:    non-locking variant).

    1577:    Level: advanced

    1579: .seealso: NEPNLEIGSGetLocking()
    1580: @*/
    1581: PetscErrorCode NEPNLEIGSSetLocking(NEP nep,PetscBool lock)
    1582: {

    1588:   PetscTryMethod(nep,"NEPNLEIGSSetLocking_C",(NEP,PetscBool),(nep,lock));
    1589:   return(0);
    1590: }

    1592: static PetscErrorCode NEPNLEIGSGetLocking_NLEIGS(NEP nep,PetscBool *lock)
    1593: {
    1594:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1597:   *lock = ctx->lock;
    1598:   return(0);
    1599: }

    1601: /*@
    1602:    NEPNLEIGSGetLocking - Gets the locking flag used in the NLEIGS method.

    1604:    Not Collective

    1606:    Input Parameter:
    1607: .  nep - the nonlinear eigensolver context

    1609:    Output Parameter:
    1610: .  lock - the locking flag

    1612:    Level: advanced

    1614: .seealso: NEPNLEIGSSetLocking()
    1615: @*/
    1616: PetscErrorCode NEPNLEIGSGetLocking(NEP nep,PetscBool *lock)
    1617: {

    1623:   PetscUseMethod(nep,"NEPNLEIGSGetLocking_C",(NEP,PetscBool*),(nep,lock));
    1624:   return(0);
    1625: }

    1627: static PetscErrorCode NEPNLEIGSSetInterpolation_NLEIGS(NEP nep,PetscReal tol,PetscInt degree)
    1628: {
    1630:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;

    1633:   if (tol == PETSC_DEFAULT) {
    1634:     ctx->ddtol = PETSC_DEFAULT;
    1635:     nep->state = NEP_STATE_INITIAL;
    1636:   } else {
    1637:     if (tol <= 0.0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of tol. Must be > 0");
    1638:     ctx->ddtol = tol;
    1639:   }
    1640:   if (degree == PETSC_DEFAULT || degree == PETSC_DECIDE) {
    1641:     ctx->ddmaxit = 0;
    1642:     if (nep->state) { NEPReset(nep); }
    1643:     nep->state = NEP_STATE_INITIAL;
    1644:   } else {
    1645:     if (degree <= 0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of degree. Must be > 0");
    1646:     if (ctx->ddmaxit != degree) {
    1647:       ctx->ddmaxit = degree;
    1648:       if (nep->state) { NEPReset(nep); }
    1649:       nep->state = NEP_STATE_INITIAL;
    1650:     }
    1651:   }
    1652:   return(0);
    1653: }

    1655: /*@
    1656:    NEPNLEIGSSetInterpolation - Sets the tolerance and maximum degree
    1657:    when building the interpolation via divided differences.

    1659:    Logically Collective on nep

    1661:    Input Parameters:
    1662: +  nep    - the nonlinear eigensolver context
    1663: .  tol    - tolerance to stop computing divided differences
    1664: -  degree - maximum degree of interpolation

    1666:    Options Database Key:
    1667: +  -nep_nleigs_interpolation_tol <tol> - Sets the tolerance to stop computing divided differences
    1668: -  -nep_nleigs_interpolation_degree <degree> - Sets the maximum degree of interpolation

    1670:    Notes:
    1671:    Use PETSC_DEFAULT for either argument to assign a reasonably good value.

    1673:    Level: advanced

    1675: .seealso: NEPNLEIGSGetInterpolation()
    1676: @*/
    1677: PetscErrorCode NEPNLEIGSSetInterpolation(NEP nep,PetscReal tol,PetscInt degree)
    1678: {

    1685:   PetscTryMethod(nep,"NEPNLEIGSSetInterpolation_C",(NEP,PetscReal,PetscInt),(nep,tol,degree));
    1686:   return(0);
    1687: }

    1689: static PetscErrorCode NEPNLEIGSGetInterpolation_NLEIGS(NEP nep,PetscReal *tol,PetscInt *degree)
    1690: {
    1691:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1694:   if (tol)    *tol    = ctx->ddtol;
    1695:   if (degree) *degree = ctx->ddmaxit;
    1696:   return(0);
    1697: }

    1699: /*@
    1700:    NEPNLEIGSGetInterpolation - Gets the tolerance and maximum degree
    1701:    when building the interpolation via divided differences.

    1703:    Not Collective

    1705:    Input Parameter:
    1706: .  nep - the nonlinear eigensolver context

    1708:    Output Parameter:
    1709: +  tol    - tolerance to stop computing divided differences
    1710: -  degree - maximum degree of interpolation

    1712:    Level: advanced

    1714: .seealso: NEPNLEIGSSetInterpolation()
    1715: @*/
    1716: PetscErrorCode NEPNLEIGSGetInterpolation(NEP nep,PetscReal *tol,PetscInt *degree)
    1717: {

    1722:   PetscTryMethod(nep,"NEPNLEIGSGetInterpolation_C",(NEP,PetscReal*,PetscInt*),(nep,tol,degree));
    1723:   return(0);
    1724: }

    1726: static PetscErrorCode NEPNLEIGSSetRKShifts_NLEIGS(NEP nep,PetscInt ns,PetscScalar *shifts)
    1727: {
    1729:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    1730:   PetscInt       i;

    1733:   if (ns<0) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_WRONG,"Number of shifts must be non-negative");
    1734:   if (ctx->nshifts) { PetscFree(ctx->shifts); }
    1735:   for (i=0;i<ctx->nshiftsw;i++) { KSPDestroy(&ctx->ksp[i]); }
    1736:   PetscFree(ctx->ksp);
    1737:   ctx->ksp = NULL;
    1738:   if (ns) {
    1739:     PetscMalloc1(ns,&ctx->shifts);
    1740:     for (i=0;i<ns;i++) ctx->shifts[i] = shifts[i];
    1741:   }
    1742:   ctx->nshifts = ns;
    1743:   nep->state   = NEP_STATE_INITIAL;
    1744:   return(0);
    1745: }

    1747: /*@
    1748:    NEPNLEIGSSetRKShifts - Sets a list of shifts to be used in the Rational
    1749:    Krylov method.

    1751:    Logically Collective on nep

    1753:    Input Parameters:
    1754: +  nep    - the nonlinear eigensolver context
    1755: .  ns     - number of shifts
    1756: -  shifts - array of scalar values specifying the shifts

    1758:    Options Database Key:
    1759: .  -nep_nleigs_rk_shifts - Sets the list of shifts

    1761:    Notes:
    1762:    If only one shift is provided, the built subspace built is equivalent to
    1763:    shift-and-invert Krylov-Schur (provided that the absolute convergence
    1764:    criterion is used).

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

    1771:    Use ns=0 to remove previously set shifts.

    1773:    Level: advanced

    1775: .seealso: NEPNLEIGSGetRKShifts()
    1776: @*/
    1777: PetscErrorCode NEPNLEIGSSetRKShifts(NEP nep,PetscInt ns,PetscScalar shifts[])
    1778: {

    1785:   PetscTryMethod(nep,"NEPNLEIGSSetRKShifts_C",(NEP,PetscInt,PetscScalar*),(nep,ns,shifts));
    1786:   return(0);
    1787: }

    1789: static PetscErrorCode NEPNLEIGSGetRKShifts_NLEIGS(NEP nep,PetscInt *ns,PetscScalar **shifts)
    1790: {
    1792:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    1793:   PetscInt       i;

    1796:   *ns = ctx->nshifts;
    1797:   if (ctx->nshifts) {
    1798:     PetscMalloc1(ctx->nshifts,shifts);
    1799:     for (i=0;i<ctx->nshifts;i++) (*shifts)[i] = ctx->shifts[i];
    1800:   }
    1801:   return(0);
    1802: }

    1804: /*@C
    1805:    NEPNLEIGSGetRKShifts - Gets the list of shifts used in the Rational
    1806:    Krylov method.

    1808:    Not Collective

    1810:    Input Parameter:
    1811: .  nep - the nonlinear eigensolver context

    1813:    Output Parameter:
    1814: +  ns     - number of shifts
    1815: -  shifts - array of shifts

    1817:    Note:
    1818:    The user is responsible for deallocating the returned array.

    1820:    Level: advanced

    1822: .seealso: NEPNLEIGSSetRKShifts()
    1823: @*/
    1824: PetscErrorCode NEPNLEIGSGetRKShifts(NEP nep,PetscInt *ns,PetscScalar *shifts[])
    1825: {

    1832:   PetscTryMethod(nep,"NEPNLEIGSGetRKShifts_C",(NEP,PetscInt*,PetscScalar**),(nep,ns,shifts));
    1833:   return(0);
    1834: }

    1836: static PetscErrorCode NEPNLEIGSGetKSPs_NLEIGS(NEP nep,PetscInt *nsolve,KSP **ksp)
    1837: {
    1839:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
    1840:   PetscInt       i;
    1841:   PC             pc;

    1844:   if (!ctx->ksp) {
    1845:     NEPNLEIGSSetShifts(nep,&ctx->nshiftsw);
    1846:     PetscMalloc1(ctx->nshiftsw,&ctx->ksp);
    1847:     for (i=0;i<ctx->nshiftsw;i++) {
    1848:       KSPCreate(PetscObjectComm((PetscObject)nep),&ctx->ksp[i]);
    1849:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)nep,1);
    1850:       KSPSetOptionsPrefix(ctx->ksp[i],((PetscObject)nep)->prefix);
    1851:       KSPAppendOptionsPrefix(ctx->ksp[i],"nep_nleigs_");
    1852:       PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->ksp[i]);
    1853:       PetscObjectSetOptions((PetscObject)ctx->ksp[i],((PetscObject)nep)->options);
    1854:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
    1855:       KSPSetTolerances(ctx->ksp[i],SLEPC_DEFAULT_TOL,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
    1856:       KSPGetPC(ctx->ksp[i],&pc);
    1857:       KSPSetType(ctx->ksp[i],KSPPREONLY);
    1858:       PCSetType(pc,PCLU);
    1859:     }
    1860:   }
    1861:   if (nsolve) *nsolve = ctx->nshiftsw;
    1862:   if (ksp)    *ksp    = ctx->ksp;
    1863:   return(0);
    1864: }

    1866: /*@C
    1867:    NEPNLEIGSGetKSPs - Retrieve the array of linear solver objects associated with
    1868:    the nonlinear eigenvalue solver.

    1870:    Not Collective

    1872:    Input Parameter:
    1873: .  nep - nonlinear eigenvalue solver

    1875:    Output Parameters:
    1876: +  nsolve - number of returned KSP objects
    1877: -  ksp - array of linear solver object

    1879:    Notes:
    1880:    The number of KSP objects is equal to the number of shifts provided by the user,
    1881:    or 1 if the user did not provide shifts.

    1883:    Level: advanced

    1885: .seealso: NEPNLEIGSSetRKShifts()
    1886: @*/
    1887: PetscErrorCode NEPNLEIGSGetKSPs(NEP nep,PetscInt *nsolve,KSP **ksp)
    1888: {

    1893:   PetscUseMethod(nep,"NEPNLEIGSGetKSPs_C",(NEP,PetscInt*,KSP**),(nep,nsolve,ksp));
    1894:   return(0);
    1895: }

    1897: static PetscErrorCode NEPNLEIGSSetFullBasis_NLEIGS(NEP nep,PetscBool fullbasis)
    1898: {
    1899:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1902:   if (fullbasis!=ctx->fullbasis) {
    1903:     ctx->fullbasis = fullbasis;
    1904:     nep->state     = NEP_STATE_INITIAL;
    1905:     nep->useds     = PetscNot(fullbasis);
    1906:   }
    1907:   return(0);
    1908: }

    1910: /*@
    1911:    NEPNLEIGSSetFullBasis - Choose between TOAR-basis (default) and full-basis
    1912:    variants of the NLEIGS method.

    1914:    Logically Collective on nep

    1916:    Input Parameters:
    1917: +  nep  - the nonlinear eigensolver context
    1918: -  fullbasis - true if the full-basis variant must be selected

    1920:    Options Database Key:
    1921: .  -nep_nleigs_full_basis - Sets the full-basis flag

    1923:    Notes:
    1924:    The default is to use a compact representation of the Krylov basis, that is,
    1925:    V = (I otimes U) S, with a tensor BV. This behaviour can be changed so that
    1926:    the full basis V is explicitly stored and operated with. This variant is more
    1927:    expensive in terms of memory and computation, but is necessary in some cases,
    1928:    particularly for two-sided computations, see NEPSetTwoSided().

    1930:    In the full-basis variant, the NLEIGS solver uses an EPS object to explicitly
    1931:    solve the linearized eigenproblem, see NEPNLEIGSGetEPS().

    1933:    Level: advanced

    1935: .seealso: NEPNLEIGSGetFullBasis(), NEPNLEIGSGetEPS(), NEPSetTwoSided(), BVCreateTensor()
    1936: @*/
    1937: PetscErrorCode NEPNLEIGSSetFullBasis(NEP nep,PetscBool fullbasis)
    1938: {

    1944:   PetscTryMethod(nep,"NEPNLEIGSSetFullBasis_C",(NEP,PetscBool),(nep,fullbasis));
    1945:   return(0);
    1946: }

    1948: static PetscErrorCode NEPNLEIGSGetFullBasis_NLEIGS(NEP nep,PetscBool *fullbasis)
    1949: {
    1950:   NEP_NLEIGS *ctx=(NEP_NLEIGS*)nep->data;

    1953:   *fullbasis = ctx->fullbasis;
    1954:   return(0);
    1955: }

    1957: /*@
    1958:    NEPNLEIGSGetFullBasis - Gets the flag that indicates if NLEIGS is using the
    1959:    full-basis variant.

    1961:    Not Collective

    1963:    Input Parameter:
    1964: .  nep - the nonlinear eigensolver context

    1966:    Output Parameter:
    1967: .  fullbasis - the flag

    1969:    Level: advanced

    1971: .seealso: NEPNLEIGSSetFullBasis()
    1972: @*/
    1973: PetscErrorCode NEPNLEIGSGetFullBasis(NEP nep,PetscBool *fullbasis)
    1974: {

    1980:   PetscUseMethod(nep,"NEPNLEIGSGetFullBasis_C",(NEP,PetscBool*),(nep,fullbasis));
    1981:   return(0);
    1982: }

    1984: #define SHIFTMAX 30

    1986: PetscErrorCode NEPSetFromOptions_NLEIGS(PetscOptionItems *PetscOptionsObject,NEP nep)
    1987: {
    1989:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;
    1990:   PetscInt       i=0,k;
    1991:   PetscBool      flg1,flg2,b;
    1992:   PetscReal      r;
    1993:   PetscScalar    array[SHIFTMAX];

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

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

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

    2004:     PetscOptionsBool("-nep_nleigs_full_basis","Choose between TOAR and full-basis variants","NEPNLEIGSSetFullBasis",PETSC_FALSE,&b,&flg1);
    2005:     if (flg1) { NEPNLEIGSSetFullBasis(nep,b); }

    2007:     NEPNLEIGSGetInterpolation(nep,&r,&i);
    2008:     if (!i) i = PETSC_DEFAULT;
    2009:     PetscOptionsInt("-nep_nleigs_interpolation_degree","Maximum number of terms for interpolation via divided differences","NEPNLEIGSSetInterpolation",i,&i,&flg1);
    2010:     PetscOptionsReal("-nep_nleigs_interpolation_tol","Tolerance for interpolation via divided differences","NEPNLEIGSSetInterpolation",r,&r,&flg2);
    2011:     if (flg1 || flg2) { NEPNLEIGSSetInterpolation(nep,r,i); }

    2013:     k = SHIFTMAX;
    2014:     for (i=0;i<k;i++) array[i] = 0;
    2015:     PetscOptionsScalarArray("-nep_nleigs_rk_shifts","Shifts for Rational Krylov","NEPNLEIGSSetRKShifts",array,&k,&flg1);
    2016:     if (flg1) { NEPNLEIGSSetRKShifts(nep,k,array); }

    2018:   PetscOptionsTail();

    2020:   if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->nshiftsw,&ctx->ksp); }
    2021:   for (i=0;i<ctx->nshiftsw;i++) {
    2022:     KSPSetFromOptions(ctx->ksp[i]);
    2023:   }

    2025:   if (ctx->fullbasis) {
    2026:     if (!ctx->eps) { NEPNLEIGSGetEPS(nep,&ctx->eps); }
    2027:     EPSSetFromOptions(ctx->eps);
    2028:   }
    2029:   return(0);
    2030: }

    2032: PetscErrorCode NEPView_NLEIGS(NEP nep,PetscViewer viewer)
    2033: {
    2035:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;
    2036:   PetscBool      isascii;
    2037:   PetscInt       i;
    2038:   char           str[50];

    2041:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    2042:   if (isascii) {
    2043:     PetscViewerASCIIPrintf(viewer,"  %d%% of basis vectors kept after restart\n",(int)(100*ctx->keep));
    2044:     if (ctx->fullbasis) {
    2045:       PetscViewerASCIIPrintf(viewer,"  using the full-basis variant\n");
    2046:     } else {
    2047:       PetscViewerASCIIPrintf(viewer,"  using the %slocking variant\n",ctx->lock?"":"non-");
    2048:     }
    2049:     PetscViewerASCIIPrintf(viewer,"  divided difference terms: used=%D, max=%D\n",ctx->nmat,ctx->ddmaxit);
    2050:     PetscViewerASCIIPrintf(viewer,"  tolerance for divided difference convergence: %g\n",(double)ctx->ddtol);
    2051:     if (ctx->nshifts) {
    2052:       PetscViewerASCIIPrintf(viewer,"  RK shifts: ");
    2053:       PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
    2054:       for (i=0;i<ctx->nshifts;i++) {
    2055:         SlepcSNPrintfScalar(str,50,ctx->shifts[i],PETSC_FALSE);
    2056:         PetscViewerASCIIPrintf(viewer,"%s%s",str,(i<ctx->nshifts-1)?",":"");
    2057:       }
    2058:       PetscViewerASCIIPrintf(viewer,"\n");
    2059:       PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
    2060:     }
    2061:     if (!ctx->ksp) { NEPNLEIGSGetKSPs(nep,&ctx->nshiftsw,&ctx->ksp); }
    2062:     PetscViewerASCIIPushTab(viewer);
    2063:     KSPView(ctx->ksp[0],viewer);
    2064:     PetscViewerASCIIPopTab(viewer);
    2065:     if (ctx->fullbasis) {
    2066:       if (!ctx->eps) { NEPNLEIGSGetEPS(nep,&ctx->eps); }
    2067:       PetscViewerASCIIPushTab(viewer);
    2068:       EPSView(ctx->eps,viewer);
    2069:       PetscViewerASCIIPopTab(viewer);
    2070:     }
    2071:   }
    2072:   return(0);
    2073: }

    2075: PetscErrorCode NEPReset_NLEIGS(NEP nep)
    2076: {
    2078:   PetscInt       k;
    2079:   NEP_NLEIGS     *ctx=(NEP_NLEIGS*)nep->data;

    2082:   if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
    2083:     PetscFree(ctx->coeffD);
    2084:   } else {
    2085:     for (k=0;k<ctx->nmat;k++) { MatDestroy(&ctx->D[k]); }
    2086:   }
    2087:   PetscFree4(ctx->s,ctx->xi,ctx->beta,ctx->D);
    2088:   for (k=0;k<ctx->nshiftsw;k++) { KSPReset(ctx->ksp[k]); }
    2089:   if (ctx->vrn) {
    2090:     VecDestroy(&ctx->vrn);
    2091:   }
    2092:   if (ctx->fullbasis) {
    2093:     MatDestroy(&ctx->A);
    2094:     EPSReset(ctx->eps);
    2095:     for (k=0;k<4;k++) { VecDestroy(&ctx->w[k]); }
    2096:   }
    2097:   return(0);
    2098: }

    2100: PetscErrorCode NEPDestroy_NLEIGS(NEP nep)
    2101: {
    2103:   PetscInt       k;
    2104:   NEP_NLEIGS     *ctx = (NEP_NLEIGS*)nep->data;

    2107:   BVDestroy(&ctx->V);
    2108:   for (k=0;k<ctx->nshiftsw;k++) { KSPDestroy(&ctx->ksp[k]); }
    2109:   PetscFree(ctx->ksp);
    2110:   if (ctx->nshifts) { PetscFree(ctx->shifts); }
    2111:   if (ctx->fullbasis) { EPSDestroy(&ctx->eps); }
    2112:   PetscFree(nep->data);
    2113:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetSingularitiesFunction_C",NULL);
    2114:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetSingularitiesFunction_C",NULL);
    2115:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRestart_C",NULL);
    2116:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRestart_C",NULL);
    2117:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetLocking_C",NULL);
    2118:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetLocking_C",NULL);
    2119:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetInterpolation_C",NULL);
    2120:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetInterpolation_C",NULL);
    2121:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRKShifts_C",NULL);
    2122:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRKShifts_C",NULL);
    2123:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetKSPs_C",NULL);
    2124:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetFullBasis_C",NULL);
    2125:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetFullBasis_C",NULL);
    2126:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetEPS_C",NULL);
    2127:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetEPS_C",NULL);
    2128:   return(0);
    2129: }

    2131: SLEPC_EXTERN PetscErrorCode NEPCreate_NLEIGS(NEP nep)
    2132: {
    2134:   NEP_NLEIGS     *ctx;

    2137:   PetscNewLog(nep,&ctx);
    2138:   nep->data  = (void*)ctx;
    2139:   ctx->lock  = PETSC_TRUE;
    2140:   ctx->ddtol = PETSC_DEFAULT;

    2142:   nep->useds = PETSC_TRUE;
    2143:   nep->hasts = PETSC_TRUE;

    2145:   nep->ops->setup          = NEPSetUp_NLEIGS;
    2146:   nep->ops->setfromoptions = NEPSetFromOptions_NLEIGS;
    2147:   nep->ops->view           = NEPView_NLEIGS;
    2148:   nep->ops->destroy        = NEPDestroy_NLEIGS;
    2149:   nep->ops->reset          = NEPReset_NLEIGS;

    2151:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetSingularitiesFunction_C",NEPNLEIGSSetSingularitiesFunction_NLEIGS);
    2152:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetSingularitiesFunction_C",NEPNLEIGSGetSingularitiesFunction_NLEIGS);
    2153:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRestart_C",NEPNLEIGSSetRestart_NLEIGS);
    2154:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRestart_C",NEPNLEIGSGetRestart_NLEIGS);
    2155:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetLocking_C",NEPNLEIGSSetLocking_NLEIGS);
    2156:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetLocking_C",NEPNLEIGSGetLocking_NLEIGS);
    2157:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetInterpolation_C",NEPNLEIGSSetInterpolation_NLEIGS);
    2158:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetInterpolation_C",NEPNLEIGSGetInterpolation_NLEIGS);
    2159:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetRKShifts_C",NEPNLEIGSSetRKShifts_NLEIGS);
    2160:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetRKShifts_C",NEPNLEIGSGetRKShifts_NLEIGS);
    2161:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetKSPs_C",NEPNLEIGSGetKSPs_NLEIGS);
    2162:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetFullBasis_C",NEPNLEIGSSetFullBasis_NLEIGS);
    2163:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetFullBasis_C",NEPNLEIGSGetFullBasis_NLEIGS);
    2164:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSSetEPS_C",NEPNLEIGSSetEPS_NLEIGS);
    2165:   PetscObjectComposeFunction((PetscObject)nep,"NEPNLEIGSGetEPS_C",NEPNLEIGSGetEPS_NLEIGS);
    2166:   return(0);
    2167: }