LCOV - code coverage report
Current view: top level - eps/impls/ciss - ciss.c (source / functions) Hit Total Coverage
Test: SLEPc Lines: 750 812 92.4 %
Date: 2024-11-21 00:40:22 Functions: 38 39 97.4 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /*
       2             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       3             :    SLEPc - Scalable Library for Eigenvalue Problem Computations
       4             :    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
       5             : 
       6             :    This file is part of SLEPc.
       7             :    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
       8             :    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       9             : */
      10             : /*
      11             :    SLEPc eigensolver: "ciss"
      12             : 
      13             :    Method: Contour Integral Spectral Slicing
      14             : 
      15             :    Algorithm:
      16             : 
      17             :        Contour integral based on Sakurai-Sugiura method to construct a
      18             :        subspace, with various eigenpair extractions (Rayleigh-Ritz,
      19             :        explicit moment).
      20             : 
      21             :    Based on code contributed by Y. Maeda, T. Sakurai.
      22             : 
      23             :    References:
      24             : 
      25             :        [1] T. Sakurai and H. Sugiura, "A projection method for generalized
      26             :            eigenvalue problems", J. Comput. Appl. Math. 159:119-128, 2003.
      27             : 
      28             :        [2] T. Sakurai and H. Tadano, "CIRR: a Rayleigh-Ritz type method with
      29             :            contour integral for generalized eigenvalue problems", Hokkaido
      30             :            Math. J. 36:745-757, 2007.
      31             : */
      32             : 
      33             : #include <slepc/private/epsimpl.h>                /*I "slepceps.h" I*/
      34             : #include <slepc/private/slepccontour.h>
      35             : #include <slepcblaslapack.h>
      36             : 
      37             : typedef struct {
      38             :   /* user parameters */
      39             :   PetscInt          N;          /* number of integration points (32) */
      40             :   PetscInt          L;          /* block size (16) */
      41             :   PetscInt          M;          /* moment degree (N/4 = 4) */
      42             :   PetscReal         delta;      /* threshold of singular value (1e-12) */
      43             :   PetscInt          L_max;      /* maximum number of columns of the source matrix V */
      44             :   PetscReal         spurious_threshold; /* discard spurious eigenpairs */
      45             :   PetscBool         isreal;     /* A and B are real */
      46             :   PetscInt          npart;      /* number of partitions */
      47             :   PetscInt          refine_inner;
      48             :   PetscInt          refine_blocksize;
      49             :   EPSCISSQuadRule   quad;
      50             :   EPSCISSExtraction extraction;
      51             :   PetscBool         usest;
      52             :   /* private data */
      53             :   SlepcContourData  contour;
      54             :   PetscReal         *sigma;     /* threshold for numerical rank */
      55             :   PetscScalar       *weight;
      56             :   PetscScalar       *omega;
      57             :   PetscScalar       *pp;
      58             :   BV                V;
      59             :   BV                S;
      60             :   BV                pV;
      61             :   BV                Y;
      62             :   PetscBool         useconj;
      63             :   PetscBool         usest_set;  /* whether the user set the usest flag or not */
      64             :   PetscObjectId     rgid;
      65             :   PetscObjectState  rgstate;
      66             : } EPS_CISS;
      67             : 
      68             : /*
      69             :   Set up KSP solvers for every integration point, only called if !ctx->usest
      70             : */
      71          18 : static PetscErrorCode EPSCISSSetUp(EPS eps,Mat A,Mat B,Mat Pa,Mat Pb)
      72             : {
      73          18 :   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
      74          18 :   SlepcContourData contour;
      75          18 :   PetscInt         i,p_id,nsplit;
      76          18 :   Mat              Amat,Pmat;
      77          18 :   MatStructure     str,strp;
      78             : 
      79          18 :   PetscFunctionBegin;
      80          18 :   if (!ctx->contour || !ctx->contour->ksp) PetscCall(EPSCISSGetKSPs(eps,NULL,NULL));
      81          18 :   PetscAssert(ctx->contour && ctx->contour->ksp,PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Something went wrong with EPSCISSGetKSPs()");
      82          18 :   contour = ctx->contour;
      83          18 :   PetscCall(STGetMatStructure(eps->st,&str));
      84          18 :   PetscCall(STGetSplitPreconditionerInfo(eps->st,&nsplit,&strp));
      85         386 :   for (i=0;i<contour->npoints;i++) {
      86         368 :     p_id = i*contour->subcomm->n + contour->subcomm->color;
      87         368 :     PetscCall(MatDuplicate(A,MAT_COPY_VALUES,&Amat));
      88         368 :     if (B) PetscCall(MatAXPY(Amat,-ctx->omega[p_id],B,str));
      89         228 :     else PetscCall(MatShift(Amat,-ctx->omega[p_id]));
      90         368 :     if (nsplit) {
      91          64 :       PetscCall(MatDuplicate(Pa,MAT_COPY_VALUES,&Pmat));
      92          64 :       if (Pb) PetscCall(MatAXPY(Pmat,-ctx->omega[p_id],Pb,strp));
      93           0 :       else PetscCall(MatShift(Pmat,-ctx->omega[p_id]));
      94         304 :     } else Pmat = Amat;
      95         368 :     PetscCall(EPS_KSPSetOperators(contour->ksp[i],Amat,Amat));
      96         368 :     PetscCall(MatDestroy(&Amat));
      97         368 :     if (nsplit) PetscCall(MatDestroy(&Pmat));
      98             :   }
      99          18 :   PetscFunctionReturn(PETSC_SUCCESS);
     100             : }
     101             : 
     102             : /*
     103             :   Y_i = (A-z_i B)^{-1}BV for every integration point, Y=[Y_i] is in the context
     104             : */
     105          37 : static PetscErrorCode EPSCISSSolve(EPS eps,Mat B,BV V,PetscInt L_start,PetscInt L_end)
     106             : {
     107          37 :   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
     108          37 :   SlepcContourData contour;
     109          37 :   PetscInt         i,p_id;
     110          37 :   Mat              MV,BMV=NULL,MC;
     111          37 :   KSP              ksp;
     112             : 
     113          37 :   PetscFunctionBegin;
     114          37 :   if (!ctx->contour || !ctx->contour->ksp) PetscCall(EPSCISSGetKSPs(eps,NULL,NULL));
     115          37 :   contour = ctx->contour;
     116          37 :   PetscAssert(ctx->contour && ctx->contour->ksp,PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Something went wrong with EPSCISSGetKSPs()");
     117          37 :   PetscCall(BVSetActiveColumns(V,L_start,L_end));
     118          37 :   PetscCall(BVGetMat(V,&MV));
     119         941 :   for (i=0;i<contour->npoints;i++) {
     120         904 :     p_id = i*contour->subcomm->n + contour->subcomm->color;
     121         904 :     if (ctx->usest)  {
     122         504 :       PetscCall(STSetShift(eps->st,ctx->omega[p_id]));
     123         504 :       PetscCall(STGetKSP(eps->st,&ksp));
     124         400 :     } else ksp = contour->ksp[i];
     125         904 :     PetscCall(BVSetActiveColumns(ctx->Y,i*ctx->L+L_start,i*ctx->L+L_end));
     126         904 :     PetscCall(BVGetMat(ctx->Y,&MC));
     127         904 :     if (B) {
     128         324 :       if (!i) {
     129          13 :         PetscCall(MatProductCreate(B,MV,NULL,&BMV));
     130          13 :         PetscCall(MatProductSetType(BMV,MATPRODUCT_AB));
     131          13 :         PetscCall(MatProductSetFromOptions(BMV));
     132          13 :         PetscCall(MatProductSymbolic(BMV));
     133             :       }
     134         324 :       PetscCall(MatProductNumeric(BMV));
     135         324 :       PetscCall(KSPMatSolve(ksp,BMV,MC));
     136         580 :     } else PetscCall(KSPMatSolve(ksp,MV,MC));
     137         904 :     PetscCall(BVRestoreMat(ctx->Y,&MC));
     138         904 :     if (ctx->usest && i<contour->npoints-1) PetscCall(KSPReset(ksp));
     139             :   }
     140          37 :   PetscCall(MatDestroy(&BMV));
     141          37 :   PetscCall(BVRestoreMat(V,&MV));
     142          37 :   PetscFunctionReturn(PETSC_SUCCESS);
     143             : }
     144             : 
     145          70 : static PetscErrorCode rescale_eig(EPS eps,PetscInt nv)
     146             : {
     147          70 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
     148          70 :   PetscInt       i;
     149          70 :   PetscScalar    center;
     150          70 :   PetscReal      radius,a,b,c,d,rgscale;
     151             : #if defined(PETSC_USE_COMPLEX)
     152          70 :   PetscReal      start_ang,end_ang,vscale,theta;
     153             : #endif
     154          70 :   PetscBool      isring,isellipse,isinterval;
     155             : 
     156          70 :   PetscFunctionBegin;
     157          70 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse));
     158          70 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring));
     159          70 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval));
     160          70 :   PetscCall(RGGetScale(eps->rg,&rgscale));
     161          70 :   if (isinterval) {
     162          20 :     PetscCall(RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d));
     163          20 :     if (c==d) {
     164         226 :       for (i=0;i<nv;i++) {
     165             : #if defined(PETSC_USE_COMPLEX)
     166         210 :         eps->eigr[i] = PetscRealPart(eps->eigr[i]);
     167             : #else
     168             :         eps->eigi[i] = 0;
     169             : #endif
     170             :       }
     171             :     }
     172             :   }
     173          70 :   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
     174          14 :     if (isellipse) {
     175           6 :       PetscCall(RGEllipseGetParameters(eps->rg,&center,&radius,NULL));
     176          54 :       for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
     177           8 :     } else if (isinterval) {
     178           4 :       PetscCall(RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d));
     179           4 :       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
     180          14 :         for (i=0;i<nv;i++) {
     181          12 :           if (c==d) eps->eigr[i] = ((b-a)*(eps->eigr[i]+1.0)/2.0+a)*rgscale;
     182          12 :           if (a==b) {
     183             : #if defined(PETSC_USE_COMPLEX)
     184           0 :             eps->eigr[i] = ((d-c)*(eps->eigr[i]+1.0)/2.0+c)*rgscale*PETSC_i;
     185             : #else
     186             :             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
     187             : #endif
     188             :           }
     189             :         }
     190             :       } else {
     191           2 :         center = (b+a)/2.0+(d+c)/2.0*PETSC_PI;
     192           4 :         radius = PetscSqrtReal(PetscPowRealInt((b-a)/2.0,2)+PetscPowRealInt((d-c)/2.0,2));
     193          14 :         for (i=0;i<nv;i++) eps->eigr[i] = center + radius*eps->eigr[i];
     194             :       }
     195           4 :     } else if (isring) {  /* only supported in complex scalars */
     196             : #if defined(PETSC_USE_COMPLEX)
     197           4 :       PetscCall(RGRingGetParameters(eps->rg,&center,&radius,&vscale,&start_ang,&end_ang,NULL));
     198           4 :       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
     199           0 :         for (i=0;i<nv;i++) {
     200           0 :           theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(eps->eigr[i])+1.0))*PETSC_PI;
     201           0 :           eps->eigr[i] = rgscale*center + (rgscale*radius+PetscImaginaryPart(eps->eigr[i]))*PetscCMPLX(PetscCosReal(theta),vscale*PetscSinReal(theta));
     202             :         }
     203             :       } else {
     204          34 :         for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
     205             :       }
     206             : #endif
     207             :     }
     208             :   }
     209          70 :   PetscFunctionReturn(PETSC_SUCCESS);
     210             : }
     211             : 
     212          33 : static PetscErrorCode EPSSetUp_CISS(EPS eps)
     213             : {
     214          33 :   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
     215          33 :   SlepcContourData contour;
     216          33 :   PetscBool        istrivial,isring,isellipse,isinterval,flg;
     217          33 :   PetscReal        c,d;
     218          33 :   PetscInt         nsplit;
     219          33 :   PetscRandom      rand;
     220          33 :   PetscObjectId    id;
     221          33 :   PetscObjectState state;
     222          33 :   Mat              A[2],Psplit[2];
     223          33 :   Vec              v0;
     224             : 
     225          33 :   PetscFunctionBegin;
     226          33 :   EPSCheckNotStructured(eps);
     227          33 :   if (eps->ncv==PETSC_DETERMINE) {
     228          31 :     eps->ncv = ctx->L_max*ctx->M;
     229          31 :     if (eps->ncv>eps->n) {
     230          19 :       eps->ncv = eps->n;
     231          19 :       ctx->L_max = eps->ncv/ctx->M;
     232          19 :       PetscCheck(ctx->L_max,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Cannot adjust solver parameters, try setting a smaller value of M (moment size)");
     233             :     }
     234             :   } else {
     235           2 :     PetscCall(EPSSetDimensions_Default(eps,eps->nev,&eps->ncv,&eps->mpd));
     236           2 :     ctx->L_max = eps->ncv/ctx->M;
     237           2 :     if (!ctx->L_max) {
     238           0 :       ctx->L_max = 1;
     239           0 :       eps->ncv = ctx->L_max*ctx->M;
     240             :     }
     241             :   }
     242          33 :   ctx->L = PetscMin(ctx->L,ctx->L_max);
     243          33 :   if (eps->max_it==PETSC_DETERMINE) eps->max_it = 5;
     244          33 :   if (eps->mpd==PETSC_DETERMINE) eps->mpd = eps->ncv;
     245          33 :   if (!eps->which) eps->which = EPS_ALL;
     246          33 :   PetscCheck(eps->which==EPS_ALL,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This solver supports only computing all eigenvalues");
     247          33 :   EPSCheckUnsupported(eps,EPS_FEATURE_BALANCE | EPS_FEATURE_ARBITRARY | EPS_FEATURE_EXTRACTION | EPS_FEATURE_STOPPING | EPS_FEATURE_TWOSIDED);
     248             : 
     249             :   /* check region */
     250          33 :   PetscCall(RGIsTrivial(eps->rg,&istrivial));
     251          33 :   PetscCheck(!istrivial,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS requires a nontrivial region, e.g. -rg_type ellipse ...");
     252          33 :   PetscCall(RGGetComplement(eps->rg,&flg));
     253          33 :   PetscCheck(!flg,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"A region with complement flag set is not allowed");
     254          33 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse));
     255          33 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring));
     256          33 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval));
     257          33 :   PetscCheck(isellipse || isring || isinterval,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for interval, elliptic or ring regions");
     258             : 
     259             :   /* if the region has changed, then reset contour data */
     260          33 :   PetscCall(PetscObjectGetId((PetscObject)eps->rg,&id));
     261          33 :   PetscCall(PetscObjectStateGet((PetscObject)eps->rg,&state));
     262          33 :   if (ctx->rgid && (id != ctx->rgid || state != ctx->rgstate)) {
     263           0 :     PetscCall(SlepcContourDataDestroy(&ctx->contour));
     264           0 :     PetscCall(PetscInfo(eps,"Resetting the contour data structure due to a change of region\n"));
     265           0 :     ctx->rgid = id; ctx->rgstate = state;
     266             :   }
     267             : 
     268             : #if !defined(PETSC_USE_COMPLEX)
     269             :   PetscCheck(!isring,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Ring region only supported for complex scalars");
     270             : #endif
     271          33 :   if (isinterval) {
     272          10 :     PetscCall(RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d));
     273             : #if !defined(PETSC_USE_COMPLEX)
     274             :     PetscCheck(c==d && c==0.0,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"In real scalars, endpoints of the imaginary axis must be both zero");
     275             : #endif
     276          10 :     if (!ctx->quad && c==d) ctx->quad = EPS_CISS_QUADRULE_CHEBYSHEV;
     277             :   }
     278          33 :   if (!ctx->quad) ctx->quad = EPS_CISS_QUADRULE_TRAPEZOIDAL;
     279             : 
     280             :   /* create contour data structure */
     281          33 :   if (!ctx->contour) {
     282           0 :     PetscCall(RGCanUseConjugates(eps->rg,ctx->isreal,&ctx->useconj));
     283           0 :     PetscCall(SlepcContourDataCreate(ctx->useconj?ctx->N/2:ctx->N,ctx->npart,(PetscObject)eps,&ctx->contour));
     284             :   }
     285             : 
     286          33 :   PetscCall(EPSAllocateSolution(eps,0));
     287          33 :   PetscCall(BVGetRandomContext(eps->V,&rand));  /* make sure the random context is available when duplicating */
     288          33 :   if (ctx->weight) PetscCall(PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma));
     289          33 :   PetscCall(PetscMalloc4(ctx->N,&ctx->weight,ctx->N+1,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma));
     290             : 
     291             :   /* allocate basis vectors */
     292          33 :   PetscCall(BVDestroy(&ctx->S));
     293          33 :   PetscCall(BVDuplicateResize(eps->V,ctx->L*ctx->M,&ctx->S));
     294          33 :   PetscCall(BVDestroy(&ctx->V));
     295          33 :   PetscCall(BVDuplicateResize(eps->V,ctx->L,&ctx->V));
     296             : 
     297          33 :   PetscCall(STGetMatrix(eps->st,0,&A[0]));
     298          33 :   PetscCall(MatIsShell(A[0],&flg));
     299          33 :   PetscCheck(!flg,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell is not supported in this solver");
     300          33 :   if (eps->isgeneralized) PetscCall(STGetMatrix(eps->st,1,&A[1]));
     301             : 
     302          33 :   if (!ctx->usest_set) ctx->usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;
     303          33 :   PetscCheck(!ctx->usest || ctx->npart==1,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"The usest flag is not supported when partitions > 1");
     304             : 
     305             :   /* check if a user-defined split preconditioner has been set */
     306          33 :   PetscCall(STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL));
     307          33 :   if (nsplit) {
     308           4 :     PetscCall(STGetSplitPreconditionerTerm(eps->st,0,&Psplit[0]));
     309           4 :     if (eps->isgeneralized) PetscCall(STGetSplitPreconditionerTerm(eps->st,1,&Psplit[1]));
     310             :   }
     311             : 
     312          33 :   contour = ctx->contour;
     313          82 :   PetscCall(SlepcContourRedundantMat(contour,eps->isgeneralized?2:1,A,nsplit?Psplit:NULL));
     314          33 :   if (contour->pA) {
     315           8 :     PetscCall(BVGetColumn(ctx->V,0,&v0));
     316           8 :     PetscCall(SlepcContourScatterCreate(contour,v0));
     317           8 :     PetscCall(BVRestoreColumn(ctx->V,0,&v0));
     318           8 :     PetscCall(BVDestroy(&ctx->pV));
     319           8 :     PetscCall(BVCreate(PetscObjectComm((PetscObject)contour->xsub),&ctx->pV));
     320           8 :     PetscCall(BVSetSizesFromVec(ctx->pV,contour->xsub,eps->n));
     321           8 :     PetscCall(BVSetFromOptions(ctx->pV));
     322           8 :     PetscCall(BVResize(ctx->pV,ctx->L,PETSC_FALSE));
     323             :   }
     324             : 
     325          33 :   EPSCheckDefinite(eps);
     326          33 :   EPSCheckSinvertCondition(eps,ctx->usest," (with the usest flag set)");
     327             : 
     328          33 :   PetscCall(BVDestroy(&ctx->Y));
     329          33 :   if (contour->pA) {
     330           8 :     PetscCall(BVCreate(PetscObjectComm((PetscObject)contour->xsub),&ctx->Y));
     331           8 :     PetscCall(BVSetSizesFromVec(ctx->Y,contour->xsub,eps->n));
     332           8 :     PetscCall(BVSetFromOptions(ctx->Y));
     333           8 :     PetscCall(BVResize(ctx->Y,contour->npoints*ctx->L,PETSC_FALSE));
     334          25 :   } else PetscCall(BVDuplicateResize(eps->V,contour->npoints*ctx->L,&ctx->Y));
     335             : 
     336          33 :   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscCall(DSSetType(eps->ds,DSGNHEP));
     337          27 :   else if (eps->isgeneralized) {
     338          11 :     if (eps->ishermitian && eps->ispositive) PetscCall(DSSetType(eps->ds,DSGHEP));
     339           2 :     else PetscCall(DSSetType(eps->ds,DSGNHEP));
     340             :   } else {
     341          16 :     if (eps->ishermitian) PetscCall(DSSetType(eps->ds,DSHEP));
     342           9 :     else PetscCall(DSSetType(eps->ds,DSNHEP));
     343             :   }
     344          33 :   PetscCall(DSAllocate(eps->ds,eps->ncv));
     345             : 
     346             : #if !defined(PETSC_USE_COMPLEX)
     347             :   PetscCall(EPSSetWorkVecs(eps,3));
     348             :   if (!eps->ishermitian) PetscCall(PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"));
     349             : #else
     350          33 :   PetscCall(EPSSetWorkVecs(eps,2));
     351             : #endif
     352          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     353             : }
     354             : 
     355          33 : static PetscErrorCode EPSSetUpSort_CISS(EPS eps)
     356             : {
     357          33 :   SlepcSC        sc;
     358             : 
     359          33 :   PetscFunctionBegin;
     360             :   /* fill sorting criterion context */
     361          33 :   eps->sc->comparison    = SlepcCompareSmallestReal;
     362          33 :   eps->sc->comparisonctx = NULL;
     363          33 :   eps->sc->map           = NULL;
     364          33 :   eps->sc->mapobj        = NULL;
     365             : 
     366             :   /* fill sorting criterion for DS */
     367          33 :   PetscCall(DSGetSlepcSC(eps->ds,&sc));
     368          33 :   sc->comparison    = SlepcCompareLargestMagnitude;
     369          33 :   sc->comparisonctx = NULL;
     370          33 :   sc->map           = NULL;
     371          33 :   sc->mapobj        = NULL;
     372          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     373             : }
     374             : 
     375          33 : static PetscErrorCode EPSSolve_CISS(EPS eps)
     376             : {
     377          33 :   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
     378          33 :   SlepcContourData contour = ctx->contour;
     379          33 :   Mat              A,B,X,M,pA,pB,T,J,Pa=NULL,Pb=NULL;
     380          33 :   BV               V;
     381          33 :   PetscInt         i,j,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,nlocal,*inside,nsplit;
     382          33 :   PetscScalar      *Mu,*H0,*H1=NULL,*rr,*temp;
     383          33 :   PetscReal        error,max_error,norm;
     384          33 :   PetscBool        *fl1;
     385          33 :   Vec              si,si1=NULL,w[3];
     386          33 :   PetscRandom      rand;
     387             : #if defined(PETSC_USE_COMPLEX)
     388          33 :   PetscBool        isellipse;
     389          33 :   PetscReal        est_eig,eta;
     390             : #else
     391             :   PetscReal        normi;
     392             : #endif
     393             : 
     394          33 :   PetscFunctionBegin;
     395          33 :   w[0] = eps->work[0];
     396             : #if defined(PETSC_USE_COMPLEX)
     397          33 :   w[1] = NULL;
     398             : #else
     399             :   w[1] = eps->work[2];
     400             : #endif
     401          33 :   w[2] = eps->work[1];
     402          33 :   PetscCall(VecGetLocalSize(w[0],&nlocal));
     403          33 :   PetscCall(DSGetLeadingDimension(eps->ds,&ld));
     404          55 :   PetscCall(RGComputeQuadrature(eps->rg,ctx->quad==EPS_CISS_QUADRULE_CHEBYSHEV?RG_QUADRULE_CHEBYSHEV:RG_QUADRULE_TRAPEZOIDAL,ctx->N,ctx->omega,ctx->pp,ctx->weight));
     405          33 :   PetscCall(STGetNumMatrices(eps->st,&nmat));
     406          33 :   PetscCall(STGetMatrix(eps->st,0,&A));
     407          33 :   if (nmat>1) PetscCall(STGetMatrix(eps->st,1,&B));
     408          20 :   else B = NULL;
     409          33 :   J = (contour->pA && nmat>1)? contour->pA[1]: B;
     410          33 :   V = contour->pA? ctx->pV: ctx->V;
     411          33 :   if (!ctx->usest) {
     412          18 :     T = contour->pA? contour->pA[0]: A;
     413          18 :     PetscCall(STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL));
     414          18 :     if (nsplit) {
     415           3 :       if (contour->pA) {
     416           2 :         Pa = contour->pP[0];
     417           2 :         if (nsplit>1) Pb = contour->pP[1];
     418             :       } else {
     419           1 :         PetscCall(STGetSplitPreconditionerTerm(eps->st,0,&Pa));
     420           1 :         if (nsplit>1) PetscCall(STGetSplitPreconditionerTerm(eps->st,1,&Pb));
     421             :       }
     422             :     }
     423          18 :     PetscCall(EPSCISSSetUp(eps,T,J,Pa,Pb));
     424             :   }
     425          33 :   PetscCall(BVSetActiveColumns(ctx->V,0,ctx->L));
     426          33 :   PetscCall(BVSetRandomSign(ctx->V));
     427          33 :   PetscCall(BVGetRandomContext(ctx->V,&rand));
     428             : 
     429          33 :   if (contour->pA) PetscCall(BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup));
     430          33 :   PetscCall(EPSCISSSolve(eps,J,V,0,ctx->L));
     431             : #if defined(PETSC_USE_COMPLEX)
     432          33 :   PetscCall(PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse));
     433          33 :   if (isellipse) {
     434          20 :     PetscCall(BVTraceQuadrature(ctx->Y,ctx->V,ctx->L,ctx->L,ctx->weight,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj,&est_eig));
     435          20 :     PetscCall(PetscInfo(eps,"Estimated eigenvalue count: %f\n",(double)est_eig));
     436          20 :     eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
     437          20 :     L_add = PetscMax(0,(PetscInt)PetscCeilReal((est_eig*eta)/ctx->M)-ctx->L);
     438          20 :     if (L_add>ctx->L_max-ctx->L) {
     439           1 :       PetscCall(PetscInfo(eps,"Number of eigenvalues inside the contour path may be too large\n"));
     440           1 :       L_add = ctx->L_max-ctx->L;
     441             :     }
     442             :   }
     443             : #endif
     444          20 :   if (L_add>0) {
     445           2 :     PetscCall(PetscInfo(eps,"Changing L %" PetscInt_FMT " -> %" PetscInt_FMT " by Estimate #Eig\n",ctx->L,ctx->L+L_add));
     446           2 :     PetscCall(BVCISSResizeBases(ctx->S,contour->pA?ctx->pV:ctx->V,ctx->Y,ctx->L,ctx->L+L_add,ctx->M,contour->npoints));
     447           2 :     PetscCall(BVSetActiveColumns(ctx->V,ctx->L,ctx->L+L_add));
     448           2 :     PetscCall(BVSetRandomSign(ctx->V));
     449           2 :     if (contour->pA) PetscCall(BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup));
     450           2 :     ctx->L += L_add;
     451           2 :     PetscCall(EPSCISSSolve(eps,J,V,ctx->L-L_add,ctx->L));
     452             :   }
     453          33 :   PetscCall(PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0));
     454          33 :   for (i=0;i<ctx->refine_blocksize;i++) {
     455           1 :     PetscCall(BVDotQuadrature(ctx->Y,(contour->pA)?ctx->pV:ctx->V,Mu,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->subcomm,contour->npoints,ctx->useconj));
     456           1 :     PetscCall(CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0));
     457           1 :     PetscCall(PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0));
     458           1 :     PetscCall(SlepcCISS_BH_SVD(H0,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv));
     459           1 :     PetscCall(PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0));
     460           1 :     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
     461           0 :     L_add = L_base;
     462           0 :     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
     463           0 :     PetscCall(PetscInfo(eps,"Changing L %" PetscInt_FMT " -> %" PetscInt_FMT " by SVD(H0)\n",ctx->L,ctx->L+L_add));
     464           0 :     PetscCall(BVCISSResizeBases(ctx->S,contour->pA?ctx->pV:ctx->V,ctx->Y,ctx->L,ctx->L+L_add,ctx->M,contour->npoints));
     465           0 :     PetscCall(BVSetActiveColumns(ctx->V,ctx->L,ctx->L+L_add));
     466           0 :     PetscCall(BVSetRandomSign(ctx->V));
     467           0 :     if (contour->pA) PetscCall(BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup));
     468           0 :     ctx->L += L_add;
     469           0 :     PetscCall(EPSCISSSolve(eps,J,V,ctx->L-L_add,ctx->L));
     470           0 :     if (L_add) {
     471           0 :       PetscCall(PetscFree2(Mu,H0));
     472           0 :       PetscCall(PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0));
     473             :     }
     474             :   }
     475          33 :   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscCall(PetscMalloc1(ctx->L*ctx->M*ctx->L*ctx->M,&H1));
     476             : 
     477          68 :   while (eps->reason == EPS_CONVERGED_ITERATING) {
     478          35 :     eps->its++;
     479          35 :     for (inner=0;inner<=ctx->refine_inner;inner++) {
     480          35 :       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
     481           7 :         PetscCall(BVDotQuadrature(ctx->Y,(contour->pA)?ctx->pV:ctx->V,Mu,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->subcomm,contour->npoints,ctx->useconj));
     482           7 :         PetscCall(CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0));
     483           7 :         PetscCall(PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0));
     484           7 :         PetscCall(SlepcCISS_BH_SVD(H0,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv));
     485           7 :         PetscCall(PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0));
     486             :         break;
     487             :       } else {
     488          28 :         PetscCall(BVSumQuadrature(ctx->S,ctx->Y,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj));
     489          28 :         PetscCall(BVSetActiveColumns(ctx->S,0,ctx->L));
     490          28 :         PetscCall(BVSetActiveColumns(ctx->V,0,ctx->L));
     491          28 :         PetscCall(BVCopy(ctx->S,ctx->V));
     492          28 :         PetscCall(BVSVDAndRank(ctx->S,ctx->M,ctx->L,ctx->delta,BV_SVD_METHOD_REFINE,H0,ctx->sigma,&nv));
     493          28 :         if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
     494           0 :           if (contour->pA) PetscCall(BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup));
     495           0 :           PetscCall(EPSCISSSolve(eps,J,V,0,ctx->L));
     496             :         } else break;
     497             :       }
     498             :     }
     499          35 :     eps->nconv = 0;
     500          35 :     if (nv == 0) eps->reason = EPS_CONVERGED_TOL;
     501             :     else {
     502          35 :       PetscCall(DSSetDimensions(eps->ds,nv,0,0));
     503          35 :       PetscCall(DSSetState(eps->ds,DS_STATE_RAW));
     504             : 
     505          35 :       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
     506           7 :         PetscCall(CISS_BlockHankel(Mu,0,ctx->L,ctx->M,H0));
     507           7 :         PetscCall(CISS_BlockHankel(Mu,1,ctx->L,ctx->M,H1));
     508           7 :         PetscCall(DSGetArray(eps->ds,DS_MAT_A,&temp));
     509          58 :         for (j=0;j<nv;j++) {
     510         438 :           for (i=0;i<nv;i++) {
     511         387 :             temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
     512             :           }
     513             :         }
     514           7 :         PetscCall(DSRestoreArray(eps->ds,DS_MAT_A,&temp));
     515           7 :         PetscCall(DSGetArray(eps->ds,DS_MAT_B,&temp));
     516          58 :         for (j=0;j<nv;j++) {
     517         438 :           for (i=0;i<nv;i++) {
     518         387 :             temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
     519             :           }
     520             :         }
     521           7 :         PetscCall(DSRestoreArray(eps->ds,DS_MAT_B,&temp));
     522             :       } else {
     523          28 :         PetscCall(BVSetActiveColumns(ctx->S,0,nv));
     524          28 :         PetscCall(DSGetMat(eps->ds,DS_MAT_A,&pA));
     525          28 :         PetscCall(MatZeroEntries(pA));
     526          28 :         PetscCall(BVMatProject(ctx->S,A,ctx->S,pA));
     527          28 :         PetscCall(DSRestoreMat(eps->ds,DS_MAT_A,&pA));
     528          28 :         if (B) {
     529          11 :           PetscCall(DSGetMat(eps->ds,DS_MAT_B,&pB));
     530          11 :           PetscCall(MatZeroEntries(pB));
     531          11 :           PetscCall(BVMatProject(ctx->S,B,ctx->S,pB));
     532          11 :           PetscCall(DSRestoreMat(eps->ds,DS_MAT_B,&pB));
     533             :         }
     534             :       }
     535             : 
     536          35 :       PetscCall(DSSolve(eps->ds,eps->eigr,eps->eigi));
     537          35 :       PetscCall(DSSynchronize(eps->ds,eps->eigr,eps->eigi));
     538             : 
     539          35 :       PetscCall(PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr));
     540          35 :       PetscCall(rescale_eig(eps,nv));
     541          35 :       PetscCall(DSVectors(eps->ds,DS_MAT_X,NULL,NULL));
     542          35 :       PetscCall(DSGetMat(eps->ds,DS_MAT_X,&X));
     543          35 :       PetscCall(SlepcCISS_isGhost(X,nv,ctx->sigma,ctx->spurious_threshold,fl1));
     544          35 :       PetscCall(DSRestoreMat(eps->ds,DS_MAT_X,&X));
     545          35 :       PetscCall(RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside));
     546        1195 :       for (i=0;i<nv;i++) {
     547        1160 :         if (fl1[i] && inside[i]>=0) {
     548         269 :           rr[i] = 1.0;
     549         269 :           eps->nconv++;
     550         891 :         } else rr[i] = 0.0;
     551             :       }
     552          35 :       PetscCall(DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv));
     553          35 :       PetscCall(DSSynchronize(eps->ds,eps->eigr,eps->eigi));
     554          35 :       PetscCall(rescale_eig(eps,nv));
     555          35 :       PetscCall(PetscFree3(fl1,inside,rr));
     556          35 :       PetscCall(BVSetActiveColumns(eps->V,0,nv));
     557          35 :       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
     558           7 :         PetscCall(BVSumQuadrature(ctx->S,ctx->Y,ctx->M,ctx->L,ctx->L,ctx->weight,ctx->pp,contour->scatterin,contour->subcomm,contour->npoints,ctx->useconj));
     559           7 :         PetscCall(BVSetActiveColumns(ctx->S,0,ctx->L));
     560           7 :         PetscCall(BVCopy(ctx->S,ctx->V));
     561           7 :         PetscCall(BVSetActiveColumns(ctx->S,0,nv));
     562             :       }
     563          35 :       PetscCall(BVCopy(ctx->S,eps->V));
     564             : 
     565          35 :       PetscCall(DSVectors(eps->ds,DS_MAT_X,NULL,NULL));
     566          35 :       PetscCall(DSGetMat(eps->ds,DS_MAT_X,&X));
     567          35 :       PetscCall(BVMultInPlace(ctx->S,X,0,eps->nconv));
     568          35 :       if (eps->ishermitian) PetscCall(BVMultInPlace(eps->V,X,0,eps->nconv));
     569          35 :       PetscCall(DSRestoreMat(eps->ds,DS_MAT_X,&X));
     570             :       max_error = 0.0;
     571         304 :       for (i=0;i<eps->nconv;i++) {
     572         269 :         PetscCall(BVGetColumn(ctx->S,i,&si));
     573             : #if !defined(PETSC_USE_COMPLEX)
     574             :         if (eps->eigi[i]!=0.0) PetscCall(BVGetColumn(ctx->S,i+1,&si1));
     575             : #endif
     576         269 :         PetscCall(EPSComputeResidualNorm_Private(eps,PETSC_FALSE,eps->eigr[i],eps->eigi[i],si,si1,w,&error));
     577         269 :         if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {  /* vector is not normalized */
     578          35 :           PetscCall(VecNorm(si,NORM_2,&norm));
     579             : #if !defined(PETSC_USE_COMPLEX)
     580             :           if (eps->eigi[i]!=0.0) {
     581             :             PetscCall(VecNorm(si1,NORM_2,&normi));
     582             :             norm = SlepcAbsEigenvalue(norm,normi);
     583             :           }
     584             : #endif
     585          35 :           error /= norm;
     586             :         }
     587         269 :         PetscCall((*eps->converged)(eps,eps->eigr[i],eps->eigi[i],error,&error,eps->convergedctx));
     588         269 :         PetscCall(BVRestoreColumn(ctx->S,i,&si));
     589             : #if !defined(PETSC_USE_COMPLEX)
     590             :         if (eps->eigi[i]!=0.0) {
     591             :           PetscCall(BVRestoreColumn(ctx->S,i+1,&si1));
     592             :           i++;
     593             :         }
     594             : #endif
     595         369 :         max_error = PetscMax(max_error,error);
     596             :       }
     597             : 
     598          35 :       if (max_error <= eps->tol) eps->reason = EPS_CONVERGED_TOL;
     599           3 :       else if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
     600             :       else {
     601           2 :         if (eps->nconv > ctx->L) nv = eps->nconv;
     602           0 :         else if (ctx->L > nv) nv = ctx->L;
     603           2 :         nv = PetscMin(nv,ctx->L*ctx->M);
     604           2 :         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,nv,ctx->L,NULL,&M));
     605           2 :         PetscCall(MatSetRandom(M,rand));
     606           2 :         PetscCall(BVSetActiveColumns(ctx->S,0,nv));
     607           2 :         PetscCall(BVMultInPlace(ctx->S,M,0,ctx->L));
     608           2 :         PetscCall(MatDestroy(&M));
     609           2 :         PetscCall(BVSetActiveColumns(ctx->S,0,ctx->L));
     610           2 :         PetscCall(BVSetActiveColumns(ctx->V,0,ctx->L));
     611           2 :         PetscCall(BVCopy(ctx->S,ctx->V));
     612           2 :         if (contour->pA) PetscCall(BVScatter(ctx->V,ctx->pV,contour->scatterin,contour->xdup));
     613          70 :         PetscCall(EPSCISSSolve(eps,J,V,0,ctx->L));
     614             :       }
     615             :     }
     616             :   }
     617          33 :   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscCall(PetscFree(H1));
     618          33 :   PetscCall(PetscFree2(Mu,H0));
     619          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     620             : }
     621             : 
     622          33 : static PetscErrorCode EPSComputeVectors_CISS(EPS eps)
     623             : {
     624          33 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
     625          33 :   PetscInt       n;
     626          33 :   Mat            Z,B=NULL;
     627             : 
     628          33 :   PetscFunctionBegin;
     629          33 :   if (eps->ishermitian) {
     630          18 :     if (eps->isgeneralized && !eps->ispositive) PetscCall(EPSComputeVectors_Indefinite(eps));
     631          18 :     else PetscCall(EPSComputeVectors_Hermitian(eps));
     632          18 :     if (eps->isgeneralized && eps->ispositive && ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
     633             :       /* normalize to have unit B-norm */
     634           2 :       PetscCall(STGetMatrix(eps->st,1,&B));
     635           2 :       PetscCall(BVSetMatrix(eps->V,B,PETSC_FALSE));
     636           2 :       PetscCall(BVNormalize(eps->V,NULL));
     637           2 :       PetscCall(BVSetMatrix(eps->V,NULL,PETSC_FALSE));
     638             :     }
     639          18 :     PetscFunctionReturn(PETSC_SUCCESS);
     640             :   }
     641          15 :   PetscCall(DSGetDimensions(eps->ds,&n,NULL,NULL,NULL));
     642          15 :   PetscCall(BVSetActiveColumns(eps->V,0,n));
     643             : 
     644             :   /* right eigenvectors */
     645          15 :   PetscCall(DSVectors(eps->ds,DS_MAT_X,NULL,NULL));
     646             : 
     647             :   /* V = V * Z */
     648          15 :   PetscCall(DSGetMat(eps->ds,DS_MAT_X,&Z));
     649          15 :   PetscCall(BVMultInPlace(eps->V,Z,0,n));
     650          15 :   PetscCall(DSRestoreMat(eps->ds,DS_MAT_X,&Z));
     651          15 :   PetscCall(BVSetActiveColumns(eps->V,0,eps->nconv));
     652             : 
     653             :   /* normalize */
     654          15 :   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) PetscCall(BVNormalize(eps->V,NULL));
     655          15 :   PetscFunctionReturn(PETSC_SUCCESS);
     656             : }
     657             : 
     658          15 : static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
     659             : {
     660          15 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
     661          15 :   PetscInt       oN,oL,oM,oLmax,onpart;
     662          15 :   PetscMPIInt    size;
     663             : 
     664          15 :   PetscFunctionBegin;
     665          15 :   oN = ctx->N;
     666          15 :   if (ip == PETSC_DETERMINE) {
     667           0 :     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
     668          15 :   } else if (ip != PETSC_CURRENT) {
     669          15 :     PetscCheck(ip>0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
     670          15 :     PetscCheck(ip%2==0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
     671          15 :     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
     672             :   }
     673          15 :   oL = ctx->L;
     674          15 :   if (bs == PETSC_DETERMINE) {
     675           0 :     ctx->L = 16;
     676          15 :   } else if (bs != PETSC_CURRENT) {
     677          15 :     PetscCheck(bs>0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
     678          15 :     ctx->L = bs;
     679             :   }
     680          15 :   oM = ctx->M;
     681          15 :   if (ms == PETSC_DETERMINE) {
     682           0 :     ctx->M = ctx->N/4;
     683          15 :   } else if (ms != PETSC_CURRENT) {
     684          15 :     PetscCheck(ms>0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
     685          15 :     PetscCheck(ms<=ctx->N,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be less than or equal to the number of integration points");
     686          15 :     ctx->M = ms;
     687             :   }
     688          15 :   onpart = ctx->npart;
     689          15 :   if (npart == PETSC_DETERMINE) {
     690           0 :     ctx->npart = 1;
     691          15 :   } else if (npart != PETSC_CURRENT) {
     692          15 :     PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)eps),&size));
     693          15 :     PetscCheck(npart>0 && npart<=size,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of npart");
     694          15 :     ctx->npart = npart;
     695             :   }
     696          15 :   oLmax = ctx->L_max;
     697          15 :   if (bsmax == PETSC_DETERMINE) {
     698           0 :     ctx->L_max = 64;
     699          15 :   } else if (bsmax != PETSC_CURRENT) {
     700          15 :     PetscCheck(bsmax>0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
     701          15 :     ctx->L_max = PetscMax(bsmax,ctx->L);
     702             :   }
     703          15 :   if (onpart != ctx->npart || oN != ctx->N || realmats != ctx->isreal) {
     704          14 :     PetscCall(SlepcContourDataDestroy(&ctx->contour));
     705          14 :     PetscCall(PetscInfo(eps,"Resetting the contour data structure due to a change of parameters\n"));
     706          14 :     eps->state = EPS_STATE_INITIAL;
     707             :   }
     708          15 :   ctx->isreal = realmats;
     709          15 :   if (oL != ctx->L || oM != ctx->M || oLmax != ctx->L_max) eps->state = EPS_STATE_INITIAL;
     710          15 :   PetscFunctionReturn(PETSC_SUCCESS);
     711             : }
     712             : 
     713             : /*@
     714             :    EPSCISSSetSizes - Sets the values of various size parameters in the CISS solver.
     715             : 
     716             :    Logically Collective
     717             : 
     718             :    Input Parameters:
     719             : +  eps   - the eigenproblem solver context
     720             : .  ip    - number of integration points
     721             : .  bs    - block size
     722             : .  ms    - moment size
     723             : .  npart - number of partitions when splitting the communicator
     724             : .  bsmax - max block size
     725             : -  realmats - A and B are real
     726             : 
     727             :    Options Database Keys:
     728             : +  -eps_ciss_integration_points - Sets the number of integration points
     729             : .  -eps_ciss_blocksize - Sets the block size
     730             : .  -eps_ciss_moments - Sets the moment size
     731             : .  -eps_ciss_partitions - Sets the number of partitions
     732             : .  -eps_ciss_maxblocksize - Sets the maximum block size
     733             : -  -eps_ciss_realmats - A and B are real
     734             : 
     735             :    Note:
     736             :    For all integer arguments, you can use PETSC_CURRENT to keep the current value, and
     737             :    PETSC_DETERMINE to set them to a default value.
     738             : 
     739             :    The default number of partitions is 1. This means the internal KSP object is shared
     740             :    among all processes of the EPS communicator. Otherwise, the communicator is split
     741             :    into npart communicators, so that npart KSP solves proceed simultaneously.
     742             : 
     743             :    Level: advanced
     744             : 
     745             : .seealso: EPSCISSGetSizes()
     746             : @*/
     747          15 : PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
     748             : {
     749          15 :   PetscFunctionBegin;
     750          15 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     751          45 :   PetscValidLogicalCollectiveInt(eps,ip,2);
     752          45 :   PetscValidLogicalCollectiveInt(eps,bs,3);
     753          45 :   PetscValidLogicalCollectiveInt(eps,ms,4);
     754          45 :   PetscValidLogicalCollectiveInt(eps,npart,5);
     755          45 :   PetscValidLogicalCollectiveInt(eps,bsmax,6);
     756          45 :   PetscValidLogicalCollectiveBool(eps,realmats,7);
     757          15 :   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,realmats));
     758          15 :   PetscFunctionReturn(PETSC_SUCCESS);
     759             : }
     760             : 
     761          33 : static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
     762             : {
     763          33 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     764             : 
     765          33 :   PetscFunctionBegin;
     766          33 :   if (ip) *ip = ctx->N;
     767          33 :   if (bs) *bs = ctx->L;
     768          33 :   if (ms) *ms = ctx->M;
     769          33 :   if (npart) *npart = ctx->npart;
     770          33 :   if (bsmax) *bsmax = ctx->L_max;
     771          33 :   if (realmats) *realmats = ctx->isreal;
     772          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     773             : }
     774             : 
     775             : /*@
     776             :    EPSCISSGetSizes - Gets the values of various size parameters in the CISS solver.
     777             : 
     778             :    Not Collective
     779             : 
     780             :    Input Parameter:
     781             : .  eps - the eigenproblem solver context
     782             : 
     783             :    Output Parameters:
     784             : +  ip    - number of integration points
     785             : .  bs    - block size
     786             : .  ms    - moment size
     787             : .  npart - number of partitions when splitting the communicator
     788             : .  bsmax - max block size
     789             : -  realmats - A and B are real
     790             : 
     791             :    Level: advanced
     792             : 
     793             : .seealso: EPSCISSSetSizes()
     794             : @*/
     795          33 : PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
     796             : {
     797          33 :   PetscFunctionBegin;
     798          33 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     799          33 :   PetscUseMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,realmats));
     800          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     801             : }
     802             : 
     803           2 : static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
     804             : {
     805           2 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     806             : 
     807           2 :   PetscFunctionBegin;
     808           2 :   if (delta == (PetscReal)PETSC_DETERMINE) {
     809           0 :     ctx->delta = SLEPC_DEFAULT_TOL*1e-4;
     810           2 :   } else if (delta != (PetscReal)PETSC_CURRENT) {
     811           2 :     PetscCheck(delta>0.0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
     812           2 :     ctx->delta = delta;
     813             :   }
     814           2 :   if (spur == (PetscReal)PETSC_DETERMINE) {
     815           0 :     ctx->spurious_threshold = PetscSqrtReal(SLEPC_DEFAULT_TOL);
     816           2 :   } else if (spur != (PetscReal)PETSC_CURRENT) {
     817           2 :     PetscCheck(spur>0.0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
     818           2 :     ctx->spurious_threshold = spur;
     819             :   }
     820           2 :   PetscFunctionReturn(PETSC_SUCCESS);
     821             : }
     822             : 
     823             : /*@
     824             :    EPSCISSSetThreshold - Sets the values of various threshold parameters in
     825             :    the CISS solver.
     826             : 
     827             :    Logically Collective
     828             : 
     829             :    Input Parameters:
     830             : +  eps   - the eigenproblem solver context
     831             : .  delta - threshold for numerical rank
     832             : -  spur  - spurious threshold (to discard spurious eigenpairs)
     833             : 
     834             :    Options Database Keys:
     835             : +  -eps_ciss_delta - Sets the delta
     836             : -  -eps_ciss_spurious_threshold - Sets the spurious threshold
     837             : 
     838             :    Note:
     839             :    PETSC_CURRENT can be used to preserve the current value of any of the
     840             :    arguments, and PETSC_DETERMINE to set them to a default value.
     841             : 
     842             :    Level: advanced
     843             : 
     844             : .seealso: EPSCISSGetThreshold()
     845             : @*/
     846           2 : PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
     847             : {
     848           2 :   PetscFunctionBegin;
     849           2 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     850           6 :   PetscValidLogicalCollectiveReal(eps,delta,2);
     851           6 :   PetscValidLogicalCollectiveReal(eps,spur,3);
     852           2 :   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
     853           2 :   PetscFunctionReturn(PETSC_SUCCESS);
     854             : }
     855             : 
     856          33 : static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
     857             : {
     858          33 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     859             : 
     860          33 :   PetscFunctionBegin;
     861          33 :   if (delta) *delta = ctx->delta;
     862          33 :   if (spur)  *spur = ctx->spurious_threshold;
     863          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     864             : }
     865             : 
     866             : /*@
     867             :    EPSCISSGetThreshold - Gets the values of various threshold parameters
     868             :    in the CISS solver.
     869             : 
     870             :    Not Collective
     871             : 
     872             :    Input Parameter:
     873             : .  eps - the eigenproblem solver context
     874             : 
     875             :    Output Parameters:
     876             : +  delta - threshold for numerical rank
     877             : -  spur  - spurious threshold (to discard spurious eigenpairs)
     878             : 
     879             :    Level: advanced
     880             : 
     881             : .seealso: EPSCISSSetThreshold()
     882             : @*/
     883          33 : PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
     884             : {
     885          33 :   PetscFunctionBegin;
     886          33 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     887          33 :   PetscUseMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
     888          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     889             : }
     890             : 
     891           1 : static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt blsize)
     892             : {
     893           1 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     894             : 
     895           1 :   PetscFunctionBegin;
     896           1 :   if (inner == PETSC_DETERMINE) {
     897           0 :     ctx->refine_inner = 0;
     898           1 :   } else if (inner != PETSC_CURRENT) {
     899           1 :     PetscCheck(inner>=0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
     900           1 :     ctx->refine_inner = inner;
     901             :   }
     902           1 :   if (blsize == PETSC_DETERMINE) {
     903           0 :     ctx->refine_blocksize = 0;
     904           1 :   } else if (blsize != PETSC_CURRENT) {
     905           1 :     PetscCheck(blsize>=0,PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
     906           1 :     ctx->refine_blocksize = blsize;
     907             :   }
     908           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     909             : }
     910             : 
     911             : /*@
     912             :    EPSCISSSetRefinement - Sets the values of various refinement parameters
     913             :    in the CISS solver.
     914             : 
     915             :    Logically Collective
     916             : 
     917             :    Input Parameters:
     918             : +  eps    - the eigenproblem solver context
     919             : .  inner  - number of iterative refinement iterations (inner loop)
     920             : -  blsize - number of iterative refinement iterations (blocksize loop)
     921             : 
     922             :    Options Database Keys:
     923             : +  -eps_ciss_refine_inner - Sets number of inner iterations
     924             : -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations
     925             : 
     926             :    Note:
     927             :    PETSC_CURRENT can be used to preserve the current value of any of the
     928             :    arguments, and PETSC_DETERMINE to set them to a default of 0.
     929             : 
     930             :    Level: advanced
     931             : 
     932             : .seealso: EPSCISSGetRefinement()
     933             : @*/
     934           1 : PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt blsize)
     935             : {
     936           1 :   PetscFunctionBegin;
     937           1 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     938           3 :   PetscValidLogicalCollectiveInt(eps,inner,2);
     939           3 :   PetscValidLogicalCollectiveInt(eps,blsize,3);
     940           1 :   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt),(eps,inner,blsize));
     941           1 :   PetscFunctionReturn(PETSC_SUCCESS);
     942             : }
     943             : 
     944          33 : static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *blsize)
     945             : {
     946          33 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     947             : 
     948          33 :   PetscFunctionBegin;
     949          33 :   if (inner)  *inner = ctx->refine_inner;
     950          33 :   if (blsize) *blsize = ctx->refine_blocksize;
     951          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     952             : }
     953             : 
     954             : /*@
     955             :    EPSCISSGetRefinement - Gets the values of various refinement parameters
     956             :    in the CISS solver.
     957             : 
     958             :    Not Collective
     959             : 
     960             :    Input Parameter:
     961             : .  eps - the eigenproblem solver context
     962             : 
     963             :    Output Parameters:
     964             : +  inner  - number of iterative refinement iterations (inner loop)
     965             : -  blsize - number of iterative refinement iterations (blocksize loop)
     966             : 
     967             :    Level: advanced
     968             : 
     969             : .seealso: EPSCISSSetRefinement()
     970             : @*/
     971          33 : PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *blsize)
     972             : {
     973          33 :   PetscFunctionBegin;
     974          33 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
     975          33 :   PetscUseMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*),(eps,inner,blsize));
     976          33 :   PetscFunctionReturn(PETSC_SUCCESS);
     977             : }
     978             : 
     979          11 : static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
     980             : {
     981          11 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     982             : 
     983          11 :   PetscFunctionBegin;
     984          11 :   ctx->usest     = usest;
     985          11 :   ctx->usest_set = PETSC_TRUE;
     986          11 :   eps->state     = EPS_STATE_INITIAL;
     987          11 :   PetscFunctionReturn(PETSC_SUCCESS);
     988             : }
     989             : 
     990             : /*@
     991             :    EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
     992             :    use the ST object for the linear solves.
     993             : 
     994             :    Logically Collective
     995             : 
     996             :    Input Parameters:
     997             : +  eps    - the eigenproblem solver context
     998             : -  usest  - boolean flag to use the ST object or not
     999             : 
    1000             :    Options Database Keys:
    1001             : .  -eps_ciss_usest <bool> - whether the ST object will be used or not
    1002             : 
    1003             :    Level: advanced
    1004             : 
    1005             : .seealso: EPSCISSGetUseST()
    1006             : @*/
    1007          11 : PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
    1008             : {
    1009          11 :   PetscFunctionBegin;
    1010          11 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1011          33 :   PetscValidLogicalCollectiveBool(eps,usest,2);
    1012          11 :   PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
    1013          11 :   PetscFunctionReturn(PETSC_SUCCESS);
    1014             : }
    1015             : 
    1016          33 : static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
    1017             : {
    1018          33 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    1019             : 
    1020          33 :   PetscFunctionBegin;
    1021          33 :   *usest = ctx->usest;
    1022          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1023             : }
    1024             : 
    1025             : /*@
    1026             :    EPSCISSGetUseST - Gets the flag for using the ST object
    1027             :    in the CISS solver.
    1028             : 
    1029             :    Not Collective
    1030             : 
    1031             :    Input Parameter:
    1032             : .  eps - the eigenproblem solver context
    1033             : 
    1034             :    Output Parameters:
    1035             : .  usest - boolean flag indicating if the ST object is being used
    1036             : 
    1037             :    Level: advanced
    1038             : 
    1039             : .seealso: EPSCISSSetUseST()
    1040             : @*/
    1041          33 : PetscErrorCode EPSCISSGetUseST(EPS eps,PetscBool *usest)
    1042             : {
    1043          33 :   PetscFunctionBegin;
    1044          33 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1045          33 :   PetscAssertPointer(usest,2);
    1046          33 :   PetscUseMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
    1047          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1048             : }
    1049             : 
    1050           6 : static PetscErrorCode EPSCISSSetQuadRule_CISS(EPS eps,EPSCISSQuadRule quad)
    1051             : {
    1052           6 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    1053             : 
    1054           6 :   PetscFunctionBegin;
    1055           6 :   if (ctx->quad != quad) {
    1056           6 :     ctx->quad  = quad;
    1057           6 :     eps->state = EPS_STATE_INITIAL;
    1058             :   }
    1059           6 :   PetscFunctionReturn(PETSC_SUCCESS);
    1060             : }
    1061             : 
    1062             : /*@
    1063             :    EPSCISSSetQuadRule - Sets the quadrature rule used in the CISS solver.
    1064             : 
    1065             :    Logically Collective
    1066             : 
    1067             :    Input Parameters:
    1068             : +  eps  - the eigenproblem solver context
    1069             : -  quad - the quadrature rule
    1070             : 
    1071             :    Options Database Key:
    1072             : .  -eps_ciss_quadrule - Sets the quadrature rule (either 'trapezoidal' or
    1073             :                            'chebyshev')
    1074             : 
    1075             :    Notes:
    1076             :    By default, the trapezoidal rule is used (EPS_CISS_QUADRULE_TRAPEZOIDAL).
    1077             : 
    1078             :    If the 'chebyshev' option is specified (EPS_CISS_QUADRULE_CHEBYSHEV), then
    1079             :    Chebyshev points are used as quadrature points.
    1080             : 
    1081             :    Level: advanced
    1082             : 
    1083             : .seealso: EPSCISSGetQuadRule(), EPSCISSQuadRule
    1084             : @*/
    1085           6 : PetscErrorCode EPSCISSSetQuadRule(EPS eps,EPSCISSQuadRule quad)
    1086             : {
    1087           6 :   PetscFunctionBegin;
    1088           6 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1089          18 :   PetscValidLogicalCollectiveEnum(eps,quad,2);
    1090           6 :   PetscTryMethod(eps,"EPSCISSSetQuadRule_C",(EPS,EPSCISSQuadRule),(eps,quad));
    1091           6 :   PetscFunctionReturn(PETSC_SUCCESS);
    1092             : }
    1093             : 
    1094           1 : static PetscErrorCode EPSCISSGetQuadRule_CISS(EPS eps,EPSCISSQuadRule *quad)
    1095             : {
    1096           1 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    1097             : 
    1098           1 :   PetscFunctionBegin;
    1099           1 :   *quad = ctx->quad;
    1100           1 :   PetscFunctionReturn(PETSC_SUCCESS);
    1101             : }
    1102             : 
    1103             : /*@
    1104             :    EPSCISSGetQuadRule - Gets the quadrature rule used in the CISS solver.
    1105             : 
    1106             :    Not Collective
    1107             : 
    1108             :    Input Parameter:
    1109             : .  eps - the eigenproblem solver context
    1110             : 
    1111             :    Output Parameters:
    1112             : .  quad - quadrature rule
    1113             : 
    1114             :    Level: advanced
    1115             : 
    1116             : .seealso: EPSCISSSetQuadRule() EPSCISSQuadRule
    1117             : @*/
    1118           1 : PetscErrorCode EPSCISSGetQuadRule(EPS eps,EPSCISSQuadRule *quad)
    1119             : {
    1120           1 :   PetscFunctionBegin;
    1121           1 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1122           1 :   PetscAssertPointer(quad,2);
    1123           1 :   PetscUseMethod(eps,"EPSCISSGetQuadRule_C",(EPS,EPSCISSQuadRule*),(eps,quad));
    1124           1 :   PetscFunctionReturn(PETSC_SUCCESS);
    1125             : }
    1126             : 
    1127           8 : static PetscErrorCode EPSCISSSetExtraction_CISS(EPS eps,EPSCISSExtraction extraction)
    1128             : {
    1129           8 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    1130             : 
    1131           8 :   PetscFunctionBegin;
    1132           8 :   if (ctx->extraction != extraction) {
    1133           6 :     ctx->extraction = extraction;
    1134           6 :     eps->state      = EPS_STATE_INITIAL;
    1135             :   }
    1136           8 :   PetscFunctionReturn(PETSC_SUCCESS);
    1137             : }
    1138             : 
    1139             : /*@
    1140             :    EPSCISSSetExtraction - Sets the extraction technique used in the CISS solver.
    1141             : 
    1142             :    Logically Collective
    1143             : 
    1144             :    Input Parameters:
    1145             : +  eps        - the eigenproblem solver context
    1146             : -  extraction - the extraction technique
    1147             : 
    1148             :    Options Database Key:
    1149             : .  -eps_ciss_extraction - Sets the extraction technique (either 'ritz' or
    1150             :                            'hankel')
    1151             : 
    1152             :    Notes:
    1153             :    By default, the Rayleigh-Ritz extraction is used (EPS_CISS_EXTRACTION_RITZ).
    1154             : 
    1155             :    If the 'hankel' option is specified (EPS_CISS_EXTRACTION_HANKEL), then
    1156             :    the Block Hankel method is used for extracting eigenpairs.
    1157             : 
    1158             :    Level: advanced
    1159             : 
    1160             : .seealso: EPSCISSGetExtraction(), EPSCISSExtraction
    1161             : @*/
    1162           8 : PetscErrorCode EPSCISSSetExtraction(EPS eps,EPSCISSExtraction extraction)
    1163             : {
    1164           8 :   PetscFunctionBegin;
    1165           8 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1166          24 :   PetscValidLogicalCollectiveEnum(eps,extraction,2);
    1167           8 :   PetscTryMethod(eps,"EPSCISSSetExtraction_C",(EPS,EPSCISSExtraction),(eps,extraction));
    1168           8 :   PetscFunctionReturn(PETSC_SUCCESS);
    1169             : }
    1170             : 
    1171           1 : static PetscErrorCode EPSCISSGetExtraction_CISS(EPS eps,EPSCISSExtraction *extraction)
    1172             : {
    1173           1 :   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    1174             : 
    1175           1 :   PetscFunctionBegin;
    1176           1 :   *extraction = ctx->extraction;
    1177           1 :   PetscFunctionReturn(PETSC_SUCCESS);
    1178             : }
    1179             : 
    1180             : /*@
    1181             :    EPSCISSGetExtraction - Gets the extraction technique used in the CISS solver.
    1182             : 
    1183             :    Not Collective
    1184             : 
    1185             :    Input Parameter:
    1186             : .  eps - the eigenproblem solver context
    1187             : 
    1188             :    Output Parameters:
    1189             : .  extraction - extraction technique
    1190             : 
    1191             :    Level: advanced
    1192             : 
    1193             : .seealso: EPSCISSSetExtraction() EPSCISSExtraction
    1194             : @*/
    1195           1 : PetscErrorCode EPSCISSGetExtraction(EPS eps,EPSCISSExtraction *extraction)
    1196             : {
    1197           1 :   PetscFunctionBegin;
    1198           1 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1199           1 :   PetscAssertPointer(extraction,2);
    1200           1 :   PetscUseMethod(eps,"EPSCISSGetExtraction_C",(EPS,EPSCISSExtraction*),(eps,extraction));
    1201           1 :   PetscFunctionReturn(PETSC_SUCCESS);
    1202             : }
    1203             : 
    1204          33 : static PetscErrorCode EPSCISSGetKSPs_CISS(EPS eps,PetscInt *nsolve,KSP **ksp)
    1205             : {
    1206          33 :   EPS_CISS         *ctx = (EPS_CISS*)eps->data;
    1207          33 :   SlepcContourData contour;
    1208          33 :   PetscInt         i,nsplit;
    1209          33 :   PC               pc;
    1210          33 :   MPI_Comm         child;
    1211             : 
    1212          33 :   PetscFunctionBegin;
    1213          33 :   if (!ctx->contour) {  /* initialize contour data structure first */
    1214          33 :     PetscCall(RGCanUseConjugates(eps->rg,ctx->isreal,&ctx->useconj));
    1215          33 :     PetscCall(SlepcContourDataCreate(ctx->useconj?ctx->N/2:ctx->N,ctx->npart,(PetscObject)eps,&ctx->contour));
    1216             :   }
    1217          33 :   contour = ctx->contour;
    1218          33 :   if (!contour->ksp) {
    1219          33 :     PetscCall(PetscMalloc1(contour->npoints,&contour->ksp));
    1220          33 :     PetscCall(EPSGetST(eps,&eps->st));
    1221          33 :     PetscCall(STGetSplitPreconditionerInfo(eps->st,&nsplit,NULL));
    1222          33 :     PetscCall(PetscSubcommGetChild(contour->subcomm,&child));
    1223         841 :     for (i=0;i<contour->npoints;i++) {
    1224         808 :       PetscCall(KSPCreate(child,&contour->ksp[i]));
    1225         808 :       PetscCall(PetscObjectIncrementTabLevel((PetscObject)contour->ksp[i],(PetscObject)eps,1));
    1226         808 :       PetscCall(KSPSetOptionsPrefix(contour->ksp[i],((PetscObject)eps)->prefix));
    1227         808 :       PetscCall(KSPAppendOptionsPrefix(contour->ksp[i],"eps_ciss_"));
    1228         808 :       PetscCall(PetscObjectSetOptions((PetscObject)contour->ksp[i],((PetscObject)eps)->options));
    1229         808 :       PetscCall(KSPSetErrorIfNotConverged(contour->ksp[i],PETSC_TRUE));
    1230        1224 :       PetscCall(KSPSetTolerances(contour->ksp[i],SlepcDefaultTol(eps->tol),PETSC_CURRENT,PETSC_CURRENT,PETSC_CURRENT));
    1231         808 :       PetscCall(KSPGetPC(contour->ksp[i],&pc));
    1232         808 :       if (nsplit) {
    1233          96 :         PetscCall(KSPSetType(contour->ksp[i],KSPBCGS));
    1234          96 :         PetscCall(PCSetType(pc,PCBJACOBI));
    1235             :       } else {
    1236         712 :         PetscCall(KSPSetType(contour->ksp[i],KSPPREONLY));
    1237         808 :         PetscCall(PCSetType(pc,PCLU));
    1238             :       }
    1239             :     }
    1240             :   }
    1241          33 :   if (nsolve) *nsolve = contour->npoints;
    1242          33 :   if (ksp)    *ksp    = contour->ksp;
    1243          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1244             : }
    1245             : 
    1246             : /*@C
    1247             :    EPSCISSGetKSPs - Retrieve the array of linear solver objects associated with
    1248             :    the CISS solver.
    1249             : 
    1250             :    Not Collective
    1251             : 
    1252             :    Input Parameter:
    1253             : .  eps - the eigenproblem solver solver
    1254             : 
    1255             :    Output Parameters:
    1256             : +  nsolve - number of solver objects
    1257             : -  ksp - array of linear solver object
    1258             : 
    1259             :    Notes:
    1260             :    The number of KSP solvers is equal to the number of integration points divided by
    1261             :    the number of partitions. This value is halved in the case of real matrices with
    1262             :    a region centered at the real axis.
    1263             : 
    1264             :    Level: advanced
    1265             : 
    1266             : .seealso: EPSCISSSetSizes()
    1267             : @*/
    1268          33 : PetscErrorCode EPSCISSGetKSPs(EPS eps,PetscInt *nsolve,KSP **ksp)
    1269             : {
    1270          33 :   PetscFunctionBegin;
    1271          33 :   PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
    1272          33 :   PetscUseMethod(eps,"EPSCISSGetKSPs_C",(EPS,PetscInt*,KSP**),(eps,nsolve,ksp));
    1273          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1274             : }
    1275             : 
    1276          33 : static PetscErrorCode EPSReset_CISS(EPS eps)
    1277             : {
    1278          33 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1279             : 
    1280          33 :   PetscFunctionBegin;
    1281          33 :   PetscCall(BVDestroy(&ctx->S));
    1282          33 :   PetscCall(BVDestroy(&ctx->V));
    1283          33 :   PetscCall(BVDestroy(&ctx->Y));
    1284          33 :   if (!ctx->usest) PetscCall(SlepcContourDataReset(ctx->contour));
    1285          33 :   PetscCall(BVDestroy(&ctx->pV));
    1286          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1287             : }
    1288             : 
    1289          33 : static PetscErrorCode EPSSetFromOptions_CISS(EPS eps,PetscOptionItems *PetscOptionsObject)
    1290             : {
    1291          33 :   PetscReal         r3,r4;
    1292          33 :   PetscInt          i,i1,i2,i3,i4,i5,i6,i7;
    1293          33 :   PetscBool         b1,b2,flg,flg2,flg3,flg4,flg5,flg6;
    1294          33 :   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
    1295          33 :   EPSCISSQuadRule   quad;
    1296          33 :   EPSCISSExtraction extraction;
    1297             : 
    1298          33 :   PetscFunctionBegin;
    1299          33 :   PetscOptionsHeadBegin(PetscOptionsObject,"EPS CISS Options");
    1300             : 
    1301          33 :     PetscCall(EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1));
    1302          33 :     PetscCall(PetscOptionsInt("-eps_ciss_integration_points","Number of integration points","EPSCISSSetSizes",i1,&i1,&flg));
    1303          33 :     PetscCall(PetscOptionsInt("-eps_ciss_blocksize","Block size","EPSCISSSetSizes",i2,&i2,&flg2));
    1304          33 :     PetscCall(PetscOptionsInt("-eps_ciss_moments","Moment size","EPSCISSSetSizes",i3,&i3,&flg3));
    1305          33 :     PetscCall(PetscOptionsInt("-eps_ciss_partitions","Number of partitions","EPSCISSSetSizes",i4,&i4,&flg4));
    1306          33 :     PetscCall(PetscOptionsInt("-eps_ciss_maxblocksize","Maximum block size","EPSCISSSetSizes",i5,&i5,&flg5));
    1307          33 :     PetscCall(PetscOptionsBool("-eps_ciss_realmats","True if A and B are real","EPSCISSSetSizes",b1,&b1,&flg6));
    1308          33 :     if (flg || flg2 || flg3 || flg4 || flg5 || flg6) PetscCall(EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1));
    1309             : 
    1310          33 :     PetscCall(EPSCISSGetThreshold(eps,&r3,&r4));
    1311          33 :     PetscCall(PetscOptionsReal("-eps_ciss_delta","Threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,&flg));
    1312          33 :     PetscCall(PetscOptionsReal("-eps_ciss_spurious_threshold","Threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,&flg2));
    1313          33 :     if (flg || flg2) PetscCall(EPSCISSSetThreshold(eps,r3,r4));
    1314             : 
    1315          33 :     PetscCall(EPSCISSGetRefinement(eps,&i6,&i7));
    1316          33 :     PetscCall(PetscOptionsInt("-eps_ciss_refine_inner","Number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,&flg));
    1317          33 :     PetscCall(PetscOptionsInt("-eps_ciss_refine_blocksize","Number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,&flg2));
    1318          33 :     if (flg || flg2) PetscCall(EPSCISSSetRefinement(eps,i6,i7));
    1319             : 
    1320          33 :     PetscCall(EPSCISSGetUseST(eps,&b2));
    1321          33 :     PetscCall(PetscOptionsBool("-eps_ciss_usest","Use ST for linear solves","EPSCISSSetUseST",b2,&b2,&flg));
    1322          33 :     if (flg) PetscCall(EPSCISSSetUseST(eps,b2));
    1323             : 
    1324          33 :     PetscCall(PetscOptionsEnum("-eps_ciss_quadrule","Quadrature rule","EPSCISSSetQuadRule",EPSCISSQuadRules,(PetscEnum)ctx->quad,(PetscEnum*)&quad,&flg));
    1325          33 :     if (flg) PetscCall(EPSCISSSetQuadRule(eps,quad));
    1326             : 
    1327          33 :     PetscCall(PetscOptionsEnum("-eps_ciss_extraction","Extraction technique","EPSCISSSetExtraction",EPSCISSExtractions,(PetscEnum)ctx->extraction,(PetscEnum*)&extraction,&flg));
    1328          33 :     if (flg) PetscCall(EPSCISSSetExtraction(eps,extraction));
    1329             : 
    1330          33 :   PetscOptionsHeadEnd();
    1331             : 
    1332          33 :   if (!eps->rg) PetscCall(EPSGetRG(eps,&eps->rg));
    1333          33 :   PetscCall(RGSetFromOptions(eps->rg)); /* this is necessary here to set useconj */
    1334          33 :   if (!ctx->contour || !ctx->contour->ksp) PetscCall(EPSCISSGetKSPs(eps,NULL,NULL));
    1335          33 :   PetscAssert(ctx->contour && ctx->contour->ksp,PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Something went wrong with EPSCISSGetKSPs()");
    1336         841 :   for (i=0;i<ctx->contour->npoints;i++) PetscCall(KSPSetFromOptions(ctx->contour->ksp[i]));
    1337          33 :   PetscCall(PetscSubcommSetFromOptions(ctx->contour->subcomm));
    1338          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1339             : }
    1340             : 
    1341          33 : static PetscErrorCode EPSDestroy_CISS(EPS eps)
    1342             : {
    1343          33 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1344             : 
    1345          33 :   PetscFunctionBegin;
    1346          33 :   PetscCall(SlepcContourDataDestroy(&ctx->contour));
    1347          33 :   PetscCall(PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma));
    1348          33 :   PetscCall(PetscFree(eps->data));
    1349          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL));
    1350          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL));
    1351          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL));
    1352          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL));
    1353          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL));
    1354          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL));
    1355          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL));
    1356          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL));
    1357          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",NULL));
    1358          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",NULL));
    1359          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",NULL));
    1360          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",NULL));
    1361          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",NULL));
    1362          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1363             : }
    1364             : 
    1365           0 : static PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
    1366             : {
    1367           0 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1368           0 :   PetscBool      isascii;
    1369           0 :   PetscViewer    sviewer;
    1370             : 
    1371           0 :   PetscFunctionBegin;
    1372           0 :   PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii));
    1373           0 :   if (isascii) {
    1374           0 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  sizes { integration points: %" PetscInt_FMT ", block size: %" PetscInt_FMT ", moment size: %" PetscInt_FMT ", partitions: %" PetscInt_FMT ", maximum block size: %" PetscInt_FMT " }\n",ctx->N,ctx->L,ctx->M,ctx->npart,ctx->L_max));
    1375           0 :     if (ctx->isreal) PetscCall(PetscViewerASCIIPrintf(viewer,"  exploiting symmetry of integration points\n"));
    1376           0 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold));
    1377           0 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  iterative refinement { inner: %" PetscInt_FMT ", blocksize: %" PetscInt_FMT " }\n",ctx->refine_inner, ctx->refine_blocksize));
    1378           0 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  extraction: %s\n",EPSCISSExtractions[ctx->extraction]));
    1379           0 :     PetscCall(PetscViewerASCIIPrintf(viewer,"  quadrature rule: %s\n",EPSCISSQuadRules[ctx->quad]));
    1380           0 :     if (ctx->usest) PetscCall(PetscViewerASCIIPrintf(viewer,"  using ST for linear solves\n"));
    1381             :     else {
    1382           0 :       if (!ctx->contour || !ctx->contour->ksp) PetscCall(EPSCISSGetKSPs(eps,NULL,NULL));
    1383           0 :       PetscAssert(ctx->contour && ctx->contour->ksp,PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Something went wrong with EPSCISSGetKSPs()");
    1384           0 :       PetscCall(PetscViewerASCIIPushTab(viewer));
    1385           0 :       if (ctx->npart>1 && ctx->contour->subcomm) {
    1386           0 :         PetscCall(PetscViewerGetSubViewer(viewer,ctx->contour->subcomm->child,&sviewer));
    1387           0 :         if (!ctx->contour->subcomm->color) PetscCall(KSPView(ctx->contour->ksp[0],sviewer));
    1388           0 :         PetscCall(PetscViewerFlush(sviewer));
    1389           0 :         PetscCall(PetscViewerRestoreSubViewer(viewer,ctx->contour->subcomm->child,&sviewer));
    1390             :         /* extra call needed because of the two calls to PetscViewerASCIIPushSynchronized() in PetscViewerGetSubViewer() */
    1391           0 :         PetscCall(PetscViewerASCIIPopSynchronized(viewer));
    1392           0 :       } else PetscCall(KSPView(ctx->contour->ksp[0],viewer));
    1393           0 :       PetscCall(PetscViewerASCIIPopTab(viewer));
    1394             :     }
    1395             :   }
    1396           0 :   PetscFunctionReturn(PETSC_SUCCESS);
    1397             : }
    1398             : 
    1399          66 : static PetscErrorCode EPSSetDefaultST_CISS(EPS eps)
    1400             : {
    1401          66 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1402          66 :   PetscBool      usest = ctx->usest;
    1403          66 :   KSP            ksp;
    1404          66 :   PC             pc;
    1405             : 
    1406          66 :   PetscFunctionBegin;
    1407          66 :   if (!((PetscObject)eps->st)->type_name) {
    1408          28 :     if (!ctx->usest_set) usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;
    1409          28 :     if (usest) PetscCall(STSetType(eps->st,STSINVERT));
    1410             :     else {
    1411             :       /* we are not going to use ST, so avoid factorizing the matrix */
    1412          15 :       PetscCall(STSetType(eps->st,STSHIFT));
    1413          15 :       if (eps->isgeneralized) {
    1414           3 :         PetscCall(STGetKSP(eps->st,&ksp));
    1415           3 :         PetscCall(KSPGetPC(ksp,&pc));
    1416           3 :         PetscCall(PCSetType(pc,PCNONE));
    1417             :       }
    1418             :     }
    1419             :   }
    1420          66 :   PetscFunctionReturn(PETSC_SUCCESS);
    1421             : }
    1422             : 
    1423          33 : SLEPC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
    1424             : {
    1425          33 :   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1426             : 
    1427          33 :   PetscFunctionBegin;
    1428          33 :   PetscCall(PetscNew(&ctx));
    1429          33 :   eps->data = ctx;
    1430             : 
    1431          33 :   eps->useds = PETSC_TRUE;
    1432          33 :   eps->categ = EPS_CATEGORY_CONTOUR;
    1433             : 
    1434          33 :   eps->ops->solve          = EPSSolve_CISS;
    1435          33 :   eps->ops->setup          = EPSSetUp_CISS;
    1436          33 :   eps->ops->setupsort      = EPSSetUpSort_CISS;
    1437          33 :   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
    1438          33 :   eps->ops->destroy        = EPSDestroy_CISS;
    1439          33 :   eps->ops->reset          = EPSReset_CISS;
    1440          33 :   eps->ops->view           = EPSView_CISS;
    1441          33 :   eps->ops->computevectors = EPSComputeVectors_CISS;
    1442          33 :   eps->ops->setdefaultst   = EPSSetDefaultST_CISS;
    1443             : 
    1444          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS));
    1445          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS));
    1446          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS));
    1447          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS));
    1448          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS));
    1449          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS));
    1450          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS));
    1451          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS));
    1452          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",EPSCISSSetQuadRule_CISS));
    1453          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",EPSCISSGetQuadRule_CISS));
    1454          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",EPSCISSSetExtraction_CISS));
    1455          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",EPSCISSGetExtraction_CISS));
    1456          33 :   PetscCall(PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",EPSCISSGetKSPs_CISS));
    1457             : 
    1458             :   /* set default values of parameters */
    1459          33 :   ctx->N                  = 32;
    1460          33 :   ctx->L                  = 16;
    1461          33 :   ctx->M                  = ctx->N/4;
    1462          33 :   ctx->delta              = SLEPC_DEFAULT_TOL*1e-4;
    1463          33 :   ctx->L_max              = 64;
    1464          33 :   ctx->spurious_threshold = PetscSqrtReal(SLEPC_DEFAULT_TOL);
    1465          33 :   ctx->usest              = PETSC_TRUE;
    1466          33 :   ctx->usest_set          = PETSC_FALSE;
    1467          33 :   ctx->isreal             = PETSC_FALSE;
    1468          33 :   ctx->refine_inner       = 0;
    1469          33 :   ctx->refine_blocksize   = 0;
    1470          33 :   ctx->npart              = 1;
    1471          33 :   ctx->quad               = (EPSCISSQuadRule)0;
    1472          33 :   ctx->extraction         = EPS_CISS_EXTRACTION_RITZ;
    1473          33 :   PetscFunctionReturn(PETSC_SUCCESS);
    1474             : }

Generated by: LCOV version 1.14