Date: 2021-09-20T09:43:52+00:00

Actual source code: ciss.c
slepc-3.15.2 2021-09-20
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2021, 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 eigensolver: "ciss"

     13:    Method: Contour Integral Spectral Slicing

     15:    Algorithm:

     17:        Contour integral based on Sakurai-Sugiura method to construct a
     18:        subspace, with various eigenpair extractions (Rayleigh-Ritz,
     19:        explicit moment).

     21:    Based on code contributed by Y. Maeda, T. Sakurai.

     23:    References:

     25:        [1] T. Sakurai and H. Sugiura, "A projection method for generalized
     26:            eigenvalue problems", J. Comput. Appl. Math. 159:119-128, 2003.

     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: */

     33: #include <slepc/private/epsimpl.h>
     34: #include <slepcblaslapack.h>

     36: PetscLogEvent EPS_CISS_SVD;

     38: typedef struct {
     39:   /* parameters */
     40:   PetscInt          N;          /* number of integration points (32) */
     41:   PetscInt          L;          /* block size (16) */
     42:   PetscInt          M;          /* moment degree (N/4 = 4) */
     43:   PetscReal         delta;      /* threshold of singular value (1e-12) */
     44:   PetscInt          L_max;      /* maximum number of columns of the source matrix V */
     45:   PetscReal         spurious_threshold; /* discard spurious eigenpairs */
     46:   PetscBool         isreal;     /* A and B are real */
     47:   PetscInt          npart;      /* number of partitions */
     48:   PetscInt          refine_inner;
     49:   PetscInt          refine_blocksize;
     50:   /* private data */
     51:   PetscReal         *sigma;     /* threshold for numerical rank */
     52:   PetscInt          subcomm_id;
     53:   PetscInt          num_solve_point;
     54:   PetscScalar       *weight;
     55:   PetscScalar       *omega;
     56:   PetscScalar       *pp;
     57:   BV                V;
     58:   BV                S;
     59:   BV                pV;
     60:   BV                Y;
     61:   Vec               xsub;
     62:   Vec               xdup;
     63:   KSP               *ksp;       /* ksp array for storing factorizations at integration points */
     64:   PetscBool         useconj;
     65:   PetscReal         est_eig;
     66:   VecScatter        scatterin;
     67:   Mat               pA,pB;
     68:   PetscSubcomm      subcomm;
     69:   PetscBool         usest;
     70:   PetscBool         usest_set;  /* whether the user set the usest flag or not */
     71:   EPSCISSQuadRule   quad;
     72:   EPSCISSExtraction extraction;
     73: } EPS_CISS;

     75: /* destroy KSP objects when the number of solve points changes */
     76: PETSC_STATIC_INLINE PetscErrorCode EPSCISSResetSolvers(EPS eps)
     77: {
     79:   PetscInt       i;
     80:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

     83:   if (ctx->ksp) {
     84:     for (i=0;i<ctx->num_solve_point;i++) {
     85:       KSPDestroy(&ctx->ksp[i]);
     86:     }
     87:     PetscFree(ctx->ksp);
     88:   }
     89:   return(0);
     90: }

     92: /* clean PetscSubcomm object when the number of partitions changes */
     93: PETSC_STATIC_INLINE PetscErrorCode EPSCISSResetSubcomm(EPS eps)
     94: {
     96:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

     99:   EPSCISSResetSolvers(eps);
    100:   PetscSubcommDestroy(&ctx->subcomm);
    101:   return(0);
    102: }

    104: /* determine whether half of integration points can be avoided (use its conjugates);
    105:    depends on isreal and the center of the region */
    106: PETSC_STATIC_INLINE PetscErrorCode EPSCISSSetUseConj(EPS eps,PetscBool *useconj)
    107: {
    109:   PetscScalar    center;
    110:   PetscReal      c,d;
    111:   PetscBool      isellipse,isinterval;
    112: #if defined(PETSC_USE_COMPLEX)
    113:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    114: #endif

    117:   *useconj = PETSC_FALSE;
    118:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    119:   if (isellipse) {
    120:     RGEllipseGetParameters(eps->rg,&center,NULL,NULL);
    121: #if defined(PETSC_USE_COMPLEX)
    122:     *useconj = (ctx->isreal && PetscImaginaryPart(center) == 0.0)? PETSC_TRUE: PETSC_FALSE;
    123: #endif
    124:   } else {
    125:     PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
    126:     if (isinterval) {
    127:       RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
    128: #if defined(PETSC_USE_COMPLEX)
    129:       *useconj = (ctx->isreal && c==d)? PETSC_TRUE: PETSC_FALSE;
    130: #endif
    131:     }
    132:   }
    133:   return(0);
    134: }

    136: /* create PetscSubcomm object and determine num_solve_point (depends on npart, N, useconj) */
    137: PETSC_STATIC_INLINE PetscErrorCode EPSCISSSetUpSubComm(EPS eps,PetscInt *num_solve_point)
    138: {
    140:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    141:   PetscInt       N = ctx->N;

    144:   PetscSubcommCreate(PetscObjectComm((PetscObject)eps),&ctx->subcomm);
    145:   PetscSubcommSetNumber(ctx->subcomm,ctx->npart);
    146:   PetscSubcommSetType(ctx->subcomm,PETSC_SUBCOMM_INTERLACED);
    147:   PetscLogObjectMemory((PetscObject)eps,sizeof(PetscSubcomm));
    148:   ctx->subcomm_id = ctx->subcomm->color;
    149:   EPSCISSSetUseConj(eps,&ctx->useconj);
    150:   if (ctx->useconj) N = N/2;
    151:   *num_solve_point = N / ctx->npart;
    152:   if (N%ctx->npart > ctx->subcomm_id) (*num_solve_point)++;
    153:   return(0);
    154: }

    156: static PetscErrorCode CISSRedundantMat(EPS eps)
    157: {
    159:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    160:   Mat            A,B;
    161:   PetscInt       nmat;

    164:   STGetNumMatrices(eps->st,&nmat);
    165:   if (ctx->subcomm->n != 1) {
    166:     STGetMatrix(eps->st,0,&A);
    167:     MatDestroy(&ctx->pA);
    168:     MatCreateRedundantMatrix(A,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pA);
    169:     if (nmat>1) {
    170:       STGetMatrix(eps->st,1,&B);
    171:       MatDestroy(&ctx->pB);
    172:       MatCreateRedundantMatrix(B,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pB);
    173:     } else ctx->pB = NULL;
    174:   } else {
    175:     ctx->pA = NULL;
    176:     ctx->pB = NULL;
    177:   }
    178:   return(0);
    179: }

    181: static PetscErrorCode CISSScatterVec(EPS eps)
    182: {
    184:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    185:   IS             is1,is2;
    186:   Vec            v0;
    187:   PetscInt       i,j,k,mstart,mend,mlocal;
    188:   PetscInt       *idx1,*idx2,mloc_sub;

    191:   VecDestroy(&ctx->xsub);
    192:   MatCreateVecs(ctx->pA,&ctx->xsub,NULL);

    194:   VecDestroy(&ctx->xdup);
    195:   MatGetLocalSize(ctx->pA,&mloc_sub,NULL);
    196:   VecCreateMPI(PetscSubcommContiguousParent(ctx->subcomm),mloc_sub,PETSC_DECIDE,&ctx->xdup);

    198:   VecScatterDestroy(&ctx->scatterin);
    199:   BVGetColumn(ctx->V,0,&v0);
    200:   VecGetOwnershipRange(v0,&mstart,&mend);
    201:   mlocal = mend - mstart;
    202:   PetscMalloc2(ctx->subcomm->n*mlocal,&idx1,ctx->subcomm->n*mlocal,&idx2);
    203:   j = 0;
    204:   for (k=0;k<ctx->subcomm->n;k++) {
    205:     for (i=mstart;i<mend;i++) {
    206:       idx1[j]   = i;
    207:       idx2[j++] = i + eps->n*k;
    208:     }
    209:   }
    210:   ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx1,PETSC_COPY_VALUES,&is1);
    211:   ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx2,PETSC_COPY_VALUES,&is2);
    212:   VecScatterCreate(v0,is1,ctx->xdup,is2,&ctx->scatterin);
    213:   ISDestroy(&is1);
    214:   ISDestroy(&is2);
    215:   PetscFree2(idx1,idx2);
    216:   BVRestoreColumn(ctx->V,0,&v0);
    217:   return(0);
    218: }

    220: static PetscErrorCode SetPathParameter(EPS eps)
    221: {
    223:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    224:   PetscInt       i,j;
    225:   PetscScalar    center=0.0,tmp,tmp2,*omegai;
    226:   PetscReal      theta,radius=1.0,vscale,a,b,c,d,max_w=0.0,rgscale;
    227: #if defined(PETSC_USE_COMPLEX)
    228:   PetscReal      start_ang,end_ang;
    229: #endif
    230:   PetscBool      isring=PETSC_FALSE,isellipse=PETSC_FALSE,isinterval=PETSC_FALSE;

    233:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    234:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
    235:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
    236:   RGGetScale(eps->rg,&rgscale);
    237:   PetscMalloc1(ctx->N+1l,&omegai);
    238:   RGComputeContour(eps->rg,ctx->N,ctx->omega,omegai);
    239:   if (isellipse) {
    240:     RGEllipseGetParameters(eps->rg,&center,&radius,&vscale);
    241:     for (i=0;i<ctx->N;i++) {
    242: #if defined(PETSC_USE_COMPLEX)
    243:       theta = 2.0*PETSC_PI*(i+0.5)/ctx->N;
    244:       ctx->pp[i] = PetscCMPLX(PetscCosReal(theta),vscale*PetscSinReal(theta));
    245:       ctx->weight[i] = rgscale*radius*(PetscCMPLX(vscale*PetscCosReal(theta),PetscSinReal(theta)))/(PetscReal)ctx->N;
    246: #else
    247:       theta = (PETSC_PI/ctx->N)*(i+0.5);
    248:       ctx->pp[i] = PetscCosReal(theta);
    249:       ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
    250:       ctx->omega[i] = rgscale*(center + radius*ctx->pp[i]);
    251: #endif
    252:     }
    253:   } else if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
    254:     for (i=0;i<ctx->N;i++) {
    255:       theta = (PETSC_PI/ctx->N)*(i+0.5);
    256:       ctx->pp[i] = PetscCosReal(theta);
    257:       ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
    258:     }
    259:     if (isinterval) {
    260:       RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
    261:       if ((c!=d || c!=0.0) && (a!=b || a!=0.0)) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Endpoints of the imaginary axis or the real axis must be both zero");
    262:       for (i=0;i<ctx->N;i++) {
    263:         if (c==d) ctx->omega[i] = ((b-a)*(ctx->pp[i]+1.0)/2.0+a)*rgscale;
    264:         if (a==b) {
    265: #if defined(PETSC_USE_COMPLEX)
    266:           ctx->omega[i] = ((d-c)*(ctx->pp[i]+1.0)/2.0+c)*rgscale*PETSC_i;
    267: #else
    268:           SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
    269: #endif
    270:         }
    271:       }
    272:     }
    273:     if (isring) {  /* only supported in complex scalars */
    274: #if defined(PETSC_USE_COMPLEX)
    275:       RGRingGetParameters(eps->rg,&center,&radius,&vscale,&start_ang,&end_ang,NULL);
    276:       for (i=0;i<ctx->N;i++) {
    277:         theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(ctx->pp[i])+1.0))*PETSC_PI;
    278:         ctx->omega[i] = rgscale*(center + radius*PetscCMPLX(PetscCosReal(theta),vscale*PetscSinReal(theta)));
    279:       }
    280: #endif
    281:     }
    282:   } else {
    283:     if (isinterval) {
    284:       RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
    285:       center = rgscale*((b+a)/2.0+(d+c)/2.0*PETSC_PI);
    286:       radius = PetscSqrtReal(PetscPowRealInt(rgscale*(b-a)/2.0,2)+PetscPowRealInt(rgscale*(d-c)/2.0,2));
    287:     } else if (isring) {
    288:       RGRingGetParameters(eps->rg,&center,&radius,NULL,NULL,NULL,NULL);
    289:       center *= rgscale;
    290:       radius *= rgscale;
    291:     }
    292:     for (i=0;i<ctx->N;i++) {
    293:       ctx->pp[i] = (ctx->omega[i]-center)/radius;
    294:       tmp = 1; tmp2 = 1;
    295:       for (j=0;j<ctx->N;j++) {
    296:         tmp *= ctx->omega[j];
    297:         if (i != j) tmp2 *= ctx->omega[j]-ctx->omega[i];
    298:       }
    299:       ctx->weight[i] = tmp/tmp2;
    300:       max_w = PetscMax(PetscAbsScalar(ctx->weight[i]),max_w);
    301:     }
    302:     for (i=0;i<ctx->N;i++) ctx->weight[i] /= (PetscScalar)max_w;
    303:   }
    304:   PetscFree(omegai);
    305:   return(0);
    306: }

    308: static PetscErrorCode CISSVecSetRandom(BV V,PetscInt i0,PetscInt i1)
    309: {
    311:   PetscInt       i,j,nlocal;
    312:   PetscScalar    *vdata;
    313:   Vec            x;

    316:   BVGetSizes(V,&nlocal,NULL,NULL);
    317:   for (i=i0;i<i1;i++) {
    318:     BVSetRandomColumn(V,i);
    319:     BVGetColumn(V,i,&x);
    320:     VecGetArray(x,&vdata);
    321:     for (j=0;j<nlocal;j++) {
    322:       vdata[j] = PetscRealPart(vdata[j]);
    323:       if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
    324:       else vdata[j] = 1.0;
    325:     }
    326:     VecRestoreArray(x,&vdata);
    327:     BVRestoreColumn(V,i,&x);
    328:   }
    329:   return(0);
    330: }

    332: static PetscErrorCode VecScatterVecs(EPS eps,BV Vin,PetscInt n)
    333: {
    334:   PetscErrorCode    ierr;
    335:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
    336:   PetscInt          i;
    337:   Vec               vi,pvi;
    338:   const PetscScalar *array;

    341:   for (i=0;i<n;i++) {
    342:     BVGetColumn(Vin,i,&vi);
    343:     VecScatterBegin(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
    344:     VecScatterEnd(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
    345:     BVRestoreColumn(Vin,i,&vi);
    346:     VecGetArrayRead(ctx->xdup,&array);
    347:     VecPlaceArray(ctx->xsub,array);
    348:     BVGetColumn(ctx->pV,i,&pvi);
    349:     VecCopy(ctx->xsub,pvi);
    350:     BVRestoreColumn(ctx->pV,i,&pvi);
    351:     VecResetArray(ctx->xsub);
    352:     VecRestoreArrayRead(ctx->xdup,&array);
    353:   }
    354:   return(0);
    355: }

    357: static PetscErrorCode SolveLinearSystem(EPS eps,Mat A,Mat B,BV V,PetscInt L_start,PetscInt L_end,PetscBool initksp)
    358: {
    360:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    361:   PetscInt       i,p_id;
    362:   Mat            Fz,kspMat,MV,BMV=NULL,MC;
    363:   KSP            ksp;
    364:   const char     *prefix;

    367:   if (!ctx->ksp) { EPSCISSGetKSPs(eps,&ctx->num_solve_point,&ctx->ksp); }
    368:   if (ctx->usest) {
    369:     MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
    370:   }
    371:   BVSetActiveColumns(V,L_start,L_end);
    372:   BVGetMat(V,&MV);
    373:   if (B) {
    374:     MatProductCreate(B,MV,NULL,&BMV);
    375:     MatProductSetType(BMV,MATPRODUCT_AB);
    376:     MatProductSetFromOptions(BMV);
    377:     MatProductSymbolic(BMV);
    378:   }
    379:   for (i=0;i<ctx->num_solve_point;i++) {
    380:     p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    381:     if (!ctx->usest && initksp) {
    382:       MatDuplicate(A,MAT_COPY_VALUES,&kspMat);
    383:       if (B) {
    384:         MatAXPY(kspMat,-ctx->omega[p_id],B,UNKNOWN_NONZERO_PATTERN);
    385:       } else {
    386:         MatShift(kspMat,-ctx->omega[p_id]);
    387:       }
    388:       KSPSetOperators(ctx->ksp[i],kspMat,kspMat);
    389:       /* set Mat prefix to be the same as KSP to enable setting command-line options (e.g. MUMPS) */
    390:       KSPGetOptionsPrefix(ctx->ksp[i],&prefix);
    391:       MatSetOptionsPrefix(kspMat,prefix);
    392:       MatDestroy(&kspMat);
    393:     } else if (ctx->usest) {
    394:       STSetShift(eps->st,ctx->omega[p_id]);
    395:       STGetKSP(eps->st,&ksp);
    396:     }
    397:     BVSetActiveColumns(ctx->Y,i*ctx->L_max+L_start,i*ctx->L_max+L_end);
    398:     BVGetMat(ctx->Y,&MC);
    399:     if (B) {
    400:       MatProductNumeric(BMV);
    401:       if (ctx->usest) {
    402:         KSPMatSolve(ksp,BMV,MC);
    403:       } else {
    404:         KSPMatSolve(ctx->ksp[i],BMV,MC);
    405:       }
    406:     } else {
    407:       if (ctx->usest) {
    408:         KSPMatSolve(ksp,MV,MC);
    409:       } else {
    410:         KSPMatSolve(ctx->ksp[i],MV,MC);
    411:       }
    412:     }
    413:     if (ctx->usest && i<ctx->num_solve_point-1) { KSPReset(ksp); }
    414:     BVRestoreMat(ctx->Y,&MC);
    415:   }
    416:   MatDestroy(&BMV);
    417:   BVRestoreMat(V,&MV);
    418:   if (ctx->usest) { MatDestroy(&Fz); }
    419:   return(0);
    420: }

    422: #if defined(PETSC_USE_COMPLEX)
    423: static PetscErrorCode EstimateNumberEigs(EPS eps,PetscInt *L_add)
    424: {
    426:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    427:   PetscInt       i,j,p_id;
    428:   PetscScalar    tmp,m = 1,sum = 0.0;
    429:   PetscReal      eta;
    430:   Vec            v,vtemp,vj;

    433:   BVCreateVec(ctx->Y,&v);
    434:   BVCreateVec(ctx->V,&vtemp);
    435:   for (j=0;j<ctx->L;j++) {
    436:     VecSet(v,0);
    437:     for (i=0;i<ctx->num_solve_point; i++) {
    438:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    439:       BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
    440:       BVMultVec(ctx->Y,ctx->weight[p_id],1,v,&m);
    441:     }
    442:     BVGetColumn(ctx->V,j,&vj);
    443:     if (ctx->pA) {
    444:       VecSet(vtemp,0);
    445:       VecScatterBegin(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
    446:       VecScatterEnd(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
    447:       VecDot(vj,vtemp,&tmp);
    448:     } else {
    449:       VecDot(vj,v,&tmp);
    450:     }
    451:     BVRestoreColumn(ctx->V,j,&vj);
    452:     if (ctx->useconj) sum += PetscRealPart(tmp)*2;
    453:     else sum += tmp;
    454:   }
    455:   ctx->est_eig = PetscAbsScalar(sum/(PetscReal)ctx->L);
    456:   eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
    457:   PetscInfo1(eps,"Estimation_#Eig %f\n",(double)ctx->est_eig);
    458:   *L_add = (PetscInt)PetscCeilReal((ctx->est_eig*eta)/ctx->M) - ctx->L;
    459:   if (*L_add < 0) *L_add = 0;
    460:   if (*L_add>ctx->L_max-ctx->L) {
    461:     PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
    462:     *L_add = ctx->L_max-ctx->L;
    463:   }
    464:   VecDestroy(&v);
    465:   VecDestroy(&vtemp);
    466:   return(0);
    467: }
    468: #endif

    470: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
    471: {
    472:   PetscErrorCode    ierr;
    473:   PetscMPIInt       sub_size,len;
    474:   PetscInt          i,j,k,s;
    475:   PetscScalar       *temp,*temp2,*ppk,alp;
    476:   const PetscScalar *pM;
    477:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
    478:   Mat               M;

    481:   MPI_Comm_size(PetscSubcommChild(ctx->subcomm),&sub_size);CHKERRMPI(ierr);
    482:   PetscMalloc3(ctx->num_solve_point*ctx->L*(ctx->L+1),&temp,2*ctx->M*ctx->L*ctx->L,&temp2,ctx->num_solve_point,&ppk);
    483:   MatCreateSeqDense(PETSC_COMM_SELF,ctx->L,ctx->L_max*ctx->num_solve_point,NULL,&M);
    484:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
    485:   BVSetActiveColumns(ctx->Y,0,ctx->L_max*ctx->num_solve_point);
    486:   if (ctx->pA) {
    487:     BVSetActiveColumns(ctx->pV,0,ctx->L);
    488:     BVDot(ctx->Y,ctx->pV,M);
    489:   } else {
    490:     BVSetActiveColumns(ctx->V,0,ctx->L);
    491:     BVDot(ctx->Y,ctx->V,M);
    492:   }
    493:   MatDenseGetArrayRead(M,&pM);
    494:   for (i=0;i<ctx->num_solve_point;i++) {
    495:     for (j=0;j<ctx->L;j++) {
    496:       for (k=0;k<ctx->L;k++) {
    497:         temp[k+j*ctx->L+i*ctx->L*ctx->L]=pM[k+j*ctx->L+i*ctx->L*ctx->L_max];
    498:       }
    499:     }
    500:   }
    501:   MatDenseRestoreArrayRead(M,&pM);
    502:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    503:   for (k=0;k<2*ctx->M;k++) {
    504:     for (j=0;j<ctx->L;j++) {
    505:       for (i=0;i<ctx->num_solve_point;i++) {
    506:         alp = ppk[i]*ctx->weight[i*ctx->subcomm->n + ctx->subcomm_id];
    507:         for (s=0;s<ctx->L;s++) {
    508:           if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
    509:           else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
    510:         }
    511:       }
    512:     }
    513:     for (i=0;i<ctx->num_solve_point;i++)
    514:       ppk[i] *= ctx->pp[i*ctx->subcomm->n + ctx->subcomm_id];
    515:   }
    516:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] /= sub_size;
    517:   PetscMPIIntCast(2*ctx->M*ctx->L*ctx->L,&len);
    518:   MPIU_Allreduce(temp2,Mu,len,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)eps));
    519:   PetscFree3(temp,temp2,ppk);
    520:   MatDestroy(&M);
    521:   return(0);
    522: }

    524: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,PetscScalar *H)
    525: {
    526:   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    527:   PetscInt i,j,k,L=ctx->L,M=ctx->M;

    530:   for (k=0;k<L*M;k++)
    531:     for (j=0;j<M;j++)
    532:       for (i=0;i<L;i++)
    533:         H[j*L+i+k*L*M] = Mu[i+k*L+(j+s)*L*L];
    534:   return(0);
    535: }

    537: static PetscErrorCode SVD_H0(EPS eps,PetscScalar *S,PetscInt *K)
    538: {
    540:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    541:   PetscInt       i,ml=ctx->L*ctx->M;
    542:   PetscBLASInt   m,n,lda,ldu,ldvt,lwork,info;
    543:   PetscScalar    *work;
    544: #if defined(PETSC_USE_COMPLEX)
    545:   PetscReal      *rwork;
    546: #endif

    549:   PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0);
    550:   PetscMalloc1(5*ml,&work);
    551: #if defined(PETSC_USE_COMPLEX)
    552:   PetscMalloc1(5*ml,&rwork);
    553: #endif
    554:   PetscBLASIntCast(ml,&m);
    555:   n = m; lda = m; ldu = m; ldvt = m; lwork = 5*m;
    556:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    557: #if defined(PETSC_USE_COMPLEX)
    558:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    559: #else
    560:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    561: #endif
    562:   SlepcCheckLapackInfo("gesvd",info);
    563:   PetscFPTrapPop();
    564:   (*K) = 0;
    565:   for (i=0;i<ml;i++) {
    566:     if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
    567:   }
    568:   PetscFree(work);
    569: #if defined(PETSC_USE_COMPLEX)
    570:   PetscFree(rwork);
    571: #endif
    572:   PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0);
    573:   return(0);
    574: }

    576: static PetscErrorCode ConstructS(EPS eps)
    577: {
    579:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    580:   PetscInt       i,j,k,vec_local_size,p_id;
    581:   Vec            v,sj;
    582:   PetscScalar    *ppk, *v_data, m = 1;

    585:   BVGetSizes(ctx->Y,&vec_local_size,NULL,NULL);
    586:   PetscMalloc1(ctx->num_solve_point,&ppk);
    587:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    588:   BVCreateVec(ctx->Y,&v);
    589:   for (k=0;k<ctx->M;k++) {
    590:     for (j=0;j<ctx->L;j++) {
    591:       VecSet(v,0);
    592:       for (i=0;i<ctx->num_solve_point;i++) {
    593:         p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    594:         BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
    595:         BVMultVec(ctx->Y,ppk[i]*ctx->weight[p_id],1.0,v,&m);
    596:       }
    597:       if (ctx->useconj) {
    598:         VecGetArray(v,&v_data);
    599:         for (i=0;i<vec_local_size;i++) v_data[i] = PetscRealPart(v_data[i])*2;
    600:         VecRestoreArray(v,&v_data);
    601:       }
    602:       BVGetColumn(ctx->S,k*ctx->L+j,&sj);
    603:       if (ctx->pA) {
    604:         VecSet(sj,0);
    605:         VecScatterBegin(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
    606:         VecScatterEnd(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
    607:       } else {
    608:         VecCopy(v,sj);
    609:       }
    610:       BVRestoreColumn(ctx->S,k*ctx->L+j,&sj);
    611:     }
    612:     for (i=0;i<ctx->num_solve_point;i++) {
    613:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    614:       ppk[i] *= ctx->pp[p_id];
    615:     }
    616:   }
    617:   PetscFree(ppk);
    618:   VecDestroy(&v);
    619:   return(0);
    620: }

    622: static PetscErrorCode SVD_S(BV S,PetscInt ml,PetscReal delta,PetscReal *sigma,PetscInt *K)
    623: {
    625:   PetscInt       i,j,k,local_size;
    626:   PetscMPIInt    len;
    627:   PetscScalar    *work,*temp,*B,*tempB,*s_data,*Q1,*Q2,*temp2,alpha=1,beta=0;
    628:   PetscBLASInt   l,m,n,lda,ldu,ldvt,lwork,info,ldb,ldc;
    629: #if defined(PETSC_USE_COMPLEX)
    630:   PetscReal      *rwork;
    631: #endif

    634:   BVGetSizes(S,&local_size,NULL,NULL);
    635:   BVGetArray(S,&s_data);
    636:   PetscMalloc7(ml*ml,&temp,ml*ml,&temp2,local_size*ml,&Q1,local_size*ml,&Q2,ml*ml,&B,ml*ml,&tempB,5*ml,&work);
    637:   PetscArrayzero(B,ml*ml);
    638: #if defined(PETSC_USE_COMPLEX)
    639:   PetscMalloc1(5*ml,&rwork);
    640: #endif
    641:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);

    643:   for (i=0;i<ml;i++) B[i*ml+i]=1;

    645:   for (k=0;k<2;k++) {
    646:     PetscBLASIntCast(local_size,&m);
    647:     PetscBLASIntCast(ml,&l);
    648:     n = l; lda = m; ldb = m; ldc = l;
    649:     if (k == 0) {
    650:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,s_data,&lda,s_data,&ldb,&beta,temp,&ldc));
    651:     } else if ((k%2)==1) {
    652:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q1,&lda,Q1,&ldb,&beta,temp,&ldc));
    653:     } else {
    654:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q2,&lda,Q2,&ldb,&beta,temp,&ldc));
    655:     }
    656:     PetscArrayzero(temp2,ml*ml);
    657:     PetscMPIIntCast(ml*ml,&len);
    658:     MPIU_Allreduce(temp,temp2,len,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)S));

    660:     PetscBLASIntCast(ml,&m);
    661:     n = m; lda = m; lwork = 5*m, ldu = 1; ldvt = 1;
    662: #if defined(PETSC_USE_COMPLEX)
    663:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    664: #else
    665:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    666: #endif
    667:     SlepcCheckLapackInfo("gesvd",info);

    669:     PetscBLASIntCast(local_size,&l);
    670:     PetscBLASIntCast(ml,&n);
    671:     m = n; lda = l; ldb = m; ldc = l;
    672:     if (k==0) {
    673:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,s_data,&lda,temp2,&ldb,&beta,Q1,&ldc));
    674:     } else if ((k%2)==1) {
    675:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q1,&lda,temp2,&ldb,&beta,Q2,&ldc));
    676:     } else {
    677:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q2,&lda,temp2,&ldb,&beta,Q1,&ldc));
    678:     }

    680:     PetscBLASIntCast(ml,&l);
    681:     m = l; n = l; lda = l; ldb = m; ldc = l;
    682:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,B,&lda,temp2,&ldb,&beta,tempB,&ldc));
    683:     for (i=0;i<ml;i++) {
    684:       sigma[i] = sqrt(sigma[i]);
    685:       for (j=0;j<local_size;j++) {
    686:         if ((k%2)==1) Q2[j+i*local_size]/=sigma[i];
    687:         else Q1[j+i*local_size]/=sigma[i];
    688:       }
    689:       for (j=0;j<ml;j++) {
    690:         B[j+i*ml]=tempB[j+i*ml]*sigma[i];
    691:       }
    692:     }
    693:   }

    695:   PetscBLASIntCast(ml,&m);
    696:   n = m; lda = m; ldu=1; ldvt=1;
    697: #if defined(PETSC_USE_COMPLEX)
    698:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    699: #else
    700:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    701: #endif
    702:   SlepcCheckLapackInfo("gesvd",info);

    704:   PetscBLASIntCast(local_size,&l);
    705:   PetscBLASIntCast(ml,&n);
    706:   m = n; lda = l; ldb = m; ldc = l;
    707:   if ((k%2)==1) {
    708:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q1,&lda,B,&ldb,&beta,s_data,&ldc));
    709:   } else {
    710:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q2,&lda,B,&ldb,&beta,s_data,&ldc));
    711:   }

    713:   PetscFPTrapPop();
    714:   BVRestoreArray(S,&s_data);

    716:   (*K) = 0;
    717:   for (i=0;i<ml;i++) {
    718:     if (sigma[i]/PetscMax(sigma[0],1)>delta) (*K)++;
    719:   }
    720:   PetscFree7(temp,temp2,Q1,Q2,B,tempB,work);
    721: #if defined(PETSC_USE_COMPLEX)
    722:   PetscFree(rwork);
    723: #endif
    724:   return(0);
    725: }

    727: static PetscErrorCode isGhost(EPS eps,PetscInt ld,PetscInt nv,PetscBool *fl)
    728: {
    730:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    731:   PetscInt       i,j;
    732:   PetscScalar    *pX;
    733:   PetscReal      *tau,s1,s2,tau_max=0.0;

    736:   PetscMalloc1(nv,&tau);
    737:   DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    738:   DSGetArray(eps->ds,DS_MAT_X,&pX);

    740:   for (i=0;i<nv;i++) {
    741:     s1 = 0;
    742:     s2 = 0;
    743:     for (j=0;j<nv;j++) {
    744:       s1 += PetscAbsScalar(PetscPowScalarInt(pX[i*ld+j],2));
    745:       s2 += PetscPowRealInt(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
    746:     }
    747:     tau[i] = s1/s2;
    748:     tau_max = PetscMax(tau_max,tau[i]);
    749:   }
    750:   DSRestoreArray(eps->ds,DS_MAT_X,&pX);
    751:   for (i=0;i<nv;i++) {
    752:     tau[i] /= tau_max;
    753:   }
    754:   for (i=0;i<nv;i++) {
    755:     if (tau[i]>=ctx->spurious_threshold) fl[i] = PETSC_TRUE;
    756:     else fl[i] = PETSC_FALSE;
    757:   }
    758:   PetscFree(tau);
    759:   return(0);
    760: }

    762: static PetscErrorCode rescale_eig(EPS eps,PetscInt nv)
    763: {
    765:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    766:   PetscInt       i;
    767:   PetscScalar    center;
    768:   PetscReal      radius,a,b,c,d,rgscale;
    769: #if defined(PETSC_USE_COMPLEX)
    770:   PetscReal      start_ang,end_ang,vscale,theta;
    771: #endif
    772:   PetscBool      isring,isellipse,isinterval;

    775:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    776:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
    777:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
    778:   RGGetScale(eps->rg,&rgscale);
    779:   if (isinterval) {
    780:     RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
    781:     if (c==d) {
    782:       for (i=0;i<nv;i++) {
    783: #if defined(PETSC_USE_COMPLEX)
    784:         eps->eigr[i] = PetscRealPart(eps->eigr[i]);
    785: #else
    786:         eps->eigi[i] = 0;
    787: #endif
    788:       }
    789:     }
    790:   }
    791:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    792:     if (isellipse) {
    793:       RGEllipseGetParameters(eps->rg,&center,&radius,NULL);
    794:       for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
    795:     } else if (isinterval) {
    796:       RGIntervalGetEndpoints(eps->rg,&a,&b,&c,&d);
    797:       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
    798:         for (i=0;i<nv;i++) {
    799:           if (c==d) eps->eigr[i] = ((b-a)*(eps->eigr[i]+1.0)/2.0+a)*rgscale;
    800:           if (a==b) {
    801: #if defined(PETSC_USE_COMPLEX)
    802:             eps->eigr[i] = ((d-c)*(eps->eigr[i]+1.0)/2.0+c)*rgscale*PETSC_i;
    803: #else
    804:             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Integration points on a vertical line require complex arithmetic");
    805: #endif
    806:           }
    807:         }
    808:       } else {
    809:         center = (b+a)/2.0+(d+c)/2.0*PETSC_PI;
    810:         radius = PetscSqrtReal(PetscPowRealInt((b-a)/2.0,2)+PetscPowRealInt((d-c)/2.0,2));
    811:         for (i=0;i<nv;i++) eps->eigr[i] = center + radius*eps->eigr[i];
    812:       }
    813:     } else if (isring) {  /* only supported in complex scalars */
    814: #if defined(PETSC_USE_COMPLEX)
    815:       RGRingGetParameters(eps->rg,&center,&radius,&vscale,&start_ang,&end_ang,NULL);
    816:       if (ctx->quad == EPS_CISS_QUADRULE_CHEBYSHEV) {
    817:         for (i=0;i<nv;i++) {
    818:           theta = (start_ang*2.0+(end_ang-start_ang)*(PetscRealPart(eps->eigr[i])+1.0))*PETSC_PI;
    819:           eps->eigr[i] = rgscale*center + (rgscale*radius+PetscImaginaryPart(eps->eigr[i]))*PetscCMPLX(PetscCosReal(theta),vscale*PetscSinReal(theta));
    820:         }
    821:       } else {
    822:         for (i=0;i<nv;i++) eps->eigr[i] = rgscale*(center + radius*eps->eigr[i]);
    823:       }
    824: #endif
    825:     }
    826:   }
    827:   return(0);
    828: }

    830: PetscErrorCode EPSSetUp_CISS(EPS eps)
    831: {
    833:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    834:   PetscBool      istrivial,isring,isellipse,isinterval,flg,useconj;
    835:   PetscReal      c,d;
    836:   PetscRandom    rand;
    837:   Mat            A;

    840:   if (eps->ncv==PETSC_DEFAULT) {
    841:     eps->ncv = ctx->L_max*ctx->M;
    842:     if (eps->ncv>eps->n) {
    843:       eps->ncv = eps->n;
    844:       ctx->L_max = eps->ncv/ctx->M;
    845:       if (!ctx->L_max) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Cannot adjust solver parameters, try setting a smaller value of M (moment size)");
    846:     }
    847:   } else {
    848:     EPSSetDimensions_Default(eps,eps->nev,&eps->ncv,&eps->mpd);
    849:     ctx->L_max = eps->ncv/ctx->M;
    850:     if (!ctx->L_max) {
    851:       ctx->L_max = 1;
    852:       eps->ncv = ctx->L_max*ctx->M;
    853:     }
    854:   }
    855:   ctx->L = PetscMin(ctx->L,ctx->L_max);
    856:   if (eps->max_it==PETSC_DEFAULT) eps->max_it = 1;
    857:   if (eps->mpd==PETSC_DEFAULT) eps->mpd = eps->ncv;
    858:   if (!eps->which) eps->which = EPS_ALL;
    859:   if (eps->which!=EPS_ALL) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This solver supports only computing all eigenvalues");
    860:   EPSCheckUnsupported(eps,EPS_FEATURE_BALANCE | EPS_FEATURE_ARBITRARY | EPS_FEATURE_EXTRACTION | EPS_FEATURE_STOPPING | EPS_FEATURE_TWOSIDED);

    862:   /* check region */
    863:   RGIsTrivial(eps->rg,&istrivial);
    864:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS requires a nontrivial region, e.g. -rg_type ellipse ...");
    865:   RGGetComplement(eps->rg,&flg);
    866:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"A region with complement flag set is not allowed");
    867:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    868:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
    869:   PetscObjectTypeCompare((PetscObject)eps->rg,RGINTERVAL,&isinterval);
    870:   if (!isellipse && !isring && !isinterval) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for interval, elliptic or ring regions");
    871:   /* if useconj has changed, then reset subcomm data */
    872:   EPSCISSSetUseConj(eps,&useconj);
    873:   if (useconj!=ctx->useconj) { EPSCISSResetSubcomm(eps); }

    875: #if !defined(PETSC_USE_COMPLEX)
    876:   if (isring) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Ring region only supported for complex scalars");
    877: #endif
    878:   if (isinterval) {
    879:     RGIntervalGetEndpoints(eps->rg,NULL,NULL,&c,&d);
    880: #if !defined(PETSC_USE_COMPLEX)
    881:     if (c!=d || c!=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"In real scalars, endpoints of the imaginary axis must be both zero");
    882: #endif
    883:     if (!ctx->quad && c==d) ctx->quad = EPS_CISS_QUADRULE_CHEBYSHEV;
    884:   }
    885:   if (!ctx->quad) ctx->quad = EPS_CISS_QUADRULE_TRAPEZOIDAL;

    887:   /* create split comm */
    888:   if (!ctx->subcomm) { EPSCISSSetUpSubComm(eps,&ctx->num_solve_point); }

    890:   EPSAllocateSolution(eps,0);
    891:   BVGetRandomContext(eps->V,&rand);  /* make sure the random context is available when duplicating */
    892:   if (ctx->weight) { PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma); }
    893:   PetscMalloc4(ctx->N,&ctx->weight,ctx->N+1,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
    894:   PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));

    896:   /* allocate basis vectors */
    897:   BVDestroy(&ctx->S);
    898:   BVDuplicateResize(eps->V,ctx->L_max*ctx->M,&ctx->S);
    899:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
    900:   BVDestroy(&ctx->V);
    901:   BVDuplicateResize(eps->V,ctx->L_max,&ctx->V);
    902:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);

    904:   STGetMatrix(eps->st,0,&A);
    905:   MatIsShell(A,&flg);
    906:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell is not supported in this solver");

    908:   if (!ctx->usest_set) ctx->usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;
    909:   if (ctx->usest && ctx->npart>1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"The usest flag is not supported when partitions > 1");

    911:   CISSRedundantMat(eps);
    912:   if (ctx->pA) {
    913:     CISSScatterVec(eps);
    914:     BVDestroy(&ctx->pV);
    915:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->pV);
    916:     BVSetSizesFromVec(ctx->pV,ctx->xsub,eps->n);
    917:     BVSetFromOptions(ctx->pV);
    918:     BVResize(ctx->pV,ctx->L_max,PETSC_FALSE);
    919:     PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
    920:   }

    922:   EPSCheckSinvertCondition(eps,ctx->usest," (with the usest flag set)");

    924:   BVDestroy(&ctx->Y);
    925:   if (ctx->pA) {
    926:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->Y);
    927:     BVSetSizesFromVec(ctx->Y,ctx->xsub,eps->n);
    928:     BVSetFromOptions(ctx->Y);
    929:     BVResize(ctx->Y,ctx->num_solve_point*ctx->L_max,PETSC_FALSE);
    930:   } else {
    931:     BVDuplicateResize(eps->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);
    932:   }
    933:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);

    935:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    936:     DSSetType(eps->ds,DSGNHEP);
    937:   } else if (eps->isgeneralized) {
    938:     if (eps->ishermitian && eps->ispositive) {
    939:       DSSetType(eps->ds,DSGHEP);
    940:     } else {
    941:       DSSetType(eps->ds,DSGNHEP);
    942:     }
    943:   } else {
    944:     if (eps->ishermitian) {
    945:       DSSetType(eps->ds,DSHEP);
    946:     } else {
    947:       DSSetType(eps->ds,DSNHEP);
    948:     }
    949:   }
    950:   DSAllocate(eps->ds,eps->ncv);

    952: #if !defined(PETSC_USE_COMPLEX)
    953:   EPSSetWorkVecs(eps,3);
    954:   if (!eps->ishermitian) { PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"); }
    955: #else
    956:   EPSSetWorkVecs(eps,2);
    957: #endif
    958:   return(0);
    959: }

    961: PetscErrorCode EPSSetUpSort_CISS(EPS eps)
    962: {
    964:   SlepcSC        sc;

    967:   /* fill sorting criterion context */
    968:   eps->sc->comparison    = SlepcCompareSmallestReal;
    969:   eps->sc->comparisonctx = NULL;
    970:   eps->sc->map           = NULL;
    971:   eps->sc->mapobj        = NULL;

    973:   /* fill sorting criterion for DS */
    974:   DSGetSlepcSC(eps->ds,&sc);
    975:   sc->comparison    = SlepcCompareLargestMagnitude;
    976:   sc->comparisonctx = NULL;
    977:   sc->map           = NULL;
    978:   sc->mapobj        = NULL;
    979:   return(0);
    980: }

    982: PetscErrorCode EPSSolve_CISS(EPS eps)
    983: {
    985:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    986:   Mat            A,B,X,M,pA,pB;
    987:   PetscInt       i,j,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,nlocal,*inside;
    988:   PetscScalar    *Mu,*H0,*H1=NULL,*rr,*temp;
    989:   PetscReal      error,max_error,norm;
    990:   PetscBool      *fl1;
    991:   Vec            si,si1=NULL,w[3];
    992:   PetscRandom    rand;
    993: #if defined(PETSC_USE_COMPLEX)
    994:   PetscBool      isellipse;
    995: #else
    996:   PetscReal      normi;
    997: #endif

    1000:   w[0] = eps->work[0];
    1001: #if defined(PETSC_USE_COMPLEX)
    1002:   w[1] = NULL;
    1003: #else
    1004:   w[1] = eps->work[2];
    1005: #endif
    1006:   w[2] = eps->work[1];
    1007:   VecGetLocalSize(w[0],&nlocal);
    1008:   DSGetLeadingDimension(eps->ds,&ld);
    1009:   STGetNumMatrices(eps->st,&nmat);
    1010:   STGetMatrix(eps->st,0,&A);
    1011:   if (nmat>1) { STGetMatrix(eps->st,1,&B); }
    1012:   else B = NULL;
    1013:   SetPathParameter(eps);
    1014:   CISSVecSetRandom(ctx->V,0,ctx->L);
    1015:   BVGetRandomContext(ctx->V,&rand);

    1017:   if (ctx->pA) {
    1018:     VecScatterVecs(eps,ctx->V,ctx->L);
    1019:     SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_TRUE);
    1020:   } else {
    1021:     SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_TRUE);
    1022:   }
    1023: #if defined(PETSC_USE_COMPLEX)
    1024:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    1025:   if (isellipse) {
    1026:     EstimateNumberEigs(eps,&L_add);
    1027:   } else {
    1028:     L_add = 0;
    1029:   }
    1030: #else
    1031:   L_add = 0;
    1032: #endif
    1033:   if (L_add>0) {
    1034:     PetscInfo2(eps,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
    1035:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
    1036:     if (ctx->pA) {
    1037:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
    1038:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
    1039:     } else {
    1040:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
    1041:     }
    1042:     ctx->L += L_add;
    1043:   }
    1044:   PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
    1045:   for (i=0;i<ctx->refine_blocksize;i++) {
    1046:     CalcMu(eps,Mu);
    1047:     BlockHankel(eps,Mu,0,H0);
    1048:     SVD_H0(eps,H0,&nv);
    1049:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
    1050:     L_add = L_base;
    1051:     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
    1052:     PetscInfo2(eps,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
    1053:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add);
    1054:     if (ctx->pA) {
    1055:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
    1056:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
    1057:     } else {
    1058:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
    1059:     }
    1060:     ctx->L += L_add;
    1061:   }
    1062:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1063:     PetscMalloc1(ctx->L*ctx->M*ctx->L*ctx->M,&H1);
    1064:   }

    1066:   while (eps->reason == EPS_CONVERGED_ITERATING) {
    1067:     eps->its++;
    1068:     for (inner=0;inner<=ctx->refine_inner;inner++) {
    1069:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1070:         CalcMu(eps,Mu);
    1071:         BlockHankel(eps,Mu,0,H0);
    1072:         SVD_H0(eps,H0,&nv);
    1073:         break;
    1074:       } else {
    1075:         ConstructS(eps);
    1076:         BVSetActiveColumns(ctx->S,0,ctx->L);
    1077:         BVCopy(ctx->S,ctx->V);
    1078:         PetscLogEventBegin(EPS_CISS_SVD,eps,0,0,0);
    1079:         SVD_S(ctx->S,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
    1080:         PetscLogEventEnd(EPS_CISS_SVD,eps,0,0,0);
    1081:         if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
    1082:           if (ctx->pA) {
    1083:             VecScatterVecs(eps,ctx->V,ctx->L);
    1084:             SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
    1085:           } else {
    1086:             SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
    1087:           }
    1088:         } else break;
    1089:       }
    1090:     }
    1091:     eps->nconv = 0;
    1092:     if (nv == 0) eps->reason = EPS_CONVERGED_TOL;
    1093:     else {
    1094:       DSSetDimensions(eps->ds,nv,0,0,0);
    1095:       DSSetState(eps->ds,DS_STATE_RAW);

    1097:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1098:         BlockHankel(eps,Mu,0,H0);
    1099:         BlockHankel(eps,Mu,1,H1);
    1100:         DSGetArray(eps->ds,DS_MAT_A,&temp);
    1101:         for (j=0;j<nv;j++) {
    1102:           for (i=0;i<nv;i++) {
    1103:             temp[i+j*ld] = H1[i+j*ctx->L*ctx->M];
    1104:           }
    1105:         }
    1106:         DSRestoreArray(eps->ds,DS_MAT_A,&temp);
    1107:         DSGetArray(eps->ds,DS_MAT_B,&temp);
    1108:         for (j=0;j<nv;j++) {
    1109:           for (i=0;i<nv;i++) {
    1110:             temp[i+j*ld] = H0[i+j*ctx->L*ctx->M];
    1111:           }
    1112:         }
    1113:         DSRestoreArray(eps->ds,DS_MAT_B,&temp);
    1114:       } else {
    1115:         BVSetActiveColumns(ctx->S,0,nv);
    1116:         DSGetMat(eps->ds,DS_MAT_A,&pA);
    1117:         MatZeroEntries(pA);
    1118:         BVMatProject(ctx->S,A,ctx->S,pA);
    1119:         DSRestoreMat(eps->ds,DS_MAT_A,&pA);
    1120:         if (B) {
    1121:           DSGetMat(eps->ds,DS_MAT_B,&pB);
    1122:           MatZeroEntries(pB);
    1123:           BVMatProject(ctx->S,B,ctx->S,pB);
    1124:           DSRestoreMat(eps->ds,DS_MAT_B,&pB);
    1125:         }
    1126:       }

    1128:       DSSolve(eps->ds,eps->eigr,eps->eigi);
    1129:       DSSynchronize(eps->ds,eps->eigr,eps->eigi);

    1131:       PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
    1132:       rescale_eig(eps,nv);
    1133:       isGhost(eps,ld,nv,fl1);
    1134:       RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
    1135:       for (i=0;i<nv;i++) {
    1136:         if (fl1[i] && inside[i]>=0) {
    1137:           rr[i] = 1.0;
    1138:           eps->nconv++;
    1139:         } else rr[i] = 0.0;
    1140:       }
    1141:       DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
    1142:       DSSynchronize(eps->ds,eps->eigr,eps->eigi);
    1143:       rescale_eig(eps,nv);
    1144:       PetscFree3(fl1,inside,rr);
    1145:       BVSetActiveColumns(eps->V,0,nv);
    1146:       if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1147:         ConstructS(eps);
    1148:         BVSetActiveColumns(ctx->S,0,ctx->L);
    1149:         BVCopy(ctx->S,ctx->V);
    1150:         BVSetActiveColumns(ctx->S,0,nv);
    1151:       }
    1152:       BVCopy(ctx->S,eps->V);

    1154:       DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    1155:       DSGetMat(eps->ds,DS_MAT_X,&X);
    1156:       BVMultInPlace(ctx->S,X,0,eps->nconv);
    1157:       if (eps->ishermitian) {
    1158:         BVMultInPlace(eps->V,X,0,eps->nconv);
    1159:       }
    1160:       MatDestroy(&X);
    1161:       max_error = 0.0;
    1162:       for (i=0;i<eps->nconv;i++) {
    1163:         BVGetColumn(ctx->S,i,&si);
    1164: #if !defined(PETSC_USE_COMPLEX)
    1165:         if (eps->eigi[i]!=0.0) { BVGetColumn(ctx->S,i+1,&si1); }
    1166: #endif
    1167:         EPSComputeResidualNorm_Private(eps,PETSC_FALSE,eps->eigr[i],eps->eigi[i],si,si1,w,&error);
    1168:         if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {  /* vector is not normalized */
    1169:           VecNorm(si,NORM_2,&norm);
    1170: #if !defined(PETSC_USE_COMPLEX)
    1171:           if (eps->eigi[i]!=0.0) {
    1172:             VecNorm(si1,NORM_2,&normi);
    1173:             norm = SlepcAbsEigenvalue(norm,normi);
    1174:           }
    1175: #endif
    1176:           error /= norm;
    1177:         }
    1178:         (*eps->converged)(eps,eps->eigr[i],eps->eigi[i],error,&error,eps->convergedctx);
    1179:         BVRestoreColumn(ctx->S,i,&si);
    1180: #if !defined(PETSC_USE_COMPLEX)
    1181:         if (eps->eigi[i]!=0.0) {
    1182:           BVRestoreColumn(ctx->S,i+1,&si1);
    1183:           i++;
    1184:         }
    1185: #endif
    1186:         max_error = PetscMax(max_error,error);
    1187:       }

    1189:       if (max_error <= eps->tol) eps->reason = EPS_CONVERGED_TOL;
    1190:       else if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
    1191:       else {
    1192:         if (eps->nconv > ctx->L) {
    1193:           MatCreateSeqDense(PETSC_COMM_SELF,eps->nconv,ctx->L,NULL,&M);
    1194:           MatDenseGetArrayWrite(M,&temp);
    1195:           for (i=0;i<ctx->L*eps->nconv;i++) {
    1196:             PetscRandomGetValue(rand,&temp[i]);
    1197:             temp[i] = PetscRealPart(temp[i]);
    1198:           }
    1199:           MatDenseRestoreArrayWrite(M,&temp);
    1200:           BVSetActiveColumns(ctx->S,0,eps->nconv);
    1201:           BVMultInPlace(ctx->S,M,0,ctx->L);
    1202:           MatDestroy(&M);
    1203:           BVSetActiveColumns(ctx->S,0,ctx->L);
    1204:           BVCopy(ctx->S,ctx->V);
    1205:         }
    1206:         if (ctx->pA) {
    1207:           VecScatterVecs(eps,ctx->V,ctx->L);
    1208:           SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
    1209:         } else {
    1210:           SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
    1211:         }
    1212:       }
    1213:     }
    1214:   }
    1215:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1216:     PetscFree(H1);
    1217:   }
    1218:   PetscFree2(Mu,H0);
    1219:   return(0);
    1220: }

    1222: PetscErrorCode EPSComputeVectors_CISS(EPS eps)
    1223: {
    1225:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1226:   PetscInt       n;
    1227:   Mat            Z,B=NULL;

    1230:   if (eps->ishermitian) {
    1231:     if (eps->isgeneralized && !eps->ispositive) {
    1232:       EPSComputeVectors_Indefinite(eps);
    1233:     } else {
    1234:       EPSComputeVectors_Hermitian(eps);
    1235:     }
    1236:     if (eps->isgeneralized && eps->ispositive && ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1237:       /* normalize to have unit B-norm */
    1238:       STGetMatrix(eps->st,1,&B);
    1239:       BVSetMatrix(eps->V,B,PETSC_FALSE);
    1240:       BVNormalize(eps->V,NULL);
    1241:       BVSetMatrix(eps->V,NULL,PETSC_FALSE);
    1242:     }
    1243:     return(0);
    1244:   }
    1245:   DSGetDimensions(eps->ds,&n,NULL,NULL,NULL,NULL);
    1246:   BVSetActiveColumns(eps->V,0,n);

    1248:   /* right eigenvectors */
    1249:   DSVectors(eps->ds,DS_MAT_X,NULL,NULL);

    1251:   /* V = V * Z */
    1252:   DSGetMat(eps->ds,DS_MAT_X,&Z);
    1253:   BVMultInPlace(eps->V,Z,0,n);
    1254:   MatDestroy(&Z);
    1255:   BVSetActiveColumns(eps->V,0,eps->nconv);

    1257:   /* normalize */
    1258:   if (ctx->extraction == EPS_CISS_EXTRACTION_HANKEL) {
    1259:     BVNormalize(eps->V,NULL);
    1260:   }
    1261:   return(0);
    1262: }

    1264: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
    1265: {
    1267:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1268:   PetscInt       oN,onpart;

    1271:   oN = ctx->N;
    1272:   if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
    1273:     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
    1274:   } else {
    1275:     if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
    1276:     if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
    1277:     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
    1278:   }
    1279:   if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
    1280:     ctx->L = 16;
    1281:   } else {
    1282:     if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
    1283:     ctx->L = bs;
    1284:   }
    1285:   if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
    1286:     ctx->M = ctx->N/4;
    1287:   } else {
    1288:     if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
    1289:     if (ms>ctx->N) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be less than or equal to the number of integration points");
    1290:     ctx->M = ms;
    1291:   }
    1292:   onpart = ctx->npart;
    1293:   if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
    1294:     ctx->npart = 1;
    1295:   } else {
    1296:     if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
    1297:     ctx->npart = npart;
    1298:   }
    1299:   if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
    1300:     ctx->L_max = 64;
    1301:   } else {
    1302:     if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
    1303:     ctx->L_max = PetscMax(bsmax,ctx->L);
    1304:   }
    1305:   if (onpart != ctx->npart || oN != ctx->N || realmats != ctx->isreal) { EPSCISSResetSubcomm(eps); }
    1306:   ctx->isreal = realmats;
    1307:   eps->state = EPS_STATE_INITIAL;
    1308:   return(0);
    1309: }

    1311: /*@
    1312:    EPSCISSSetSizes - Sets the values of various size parameters in the CISS solver.

    1314:    Logically Collective on eps

    1316:    Input Parameters:
    1317: +  eps   - the eigenproblem solver context
    1318: .  ip    - number of integration points
    1319: .  bs    - block size
    1320: .  ms    - moment size
    1321: .  npart - number of partitions when splitting the communicator
    1322: .  bsmax - max block size
    1323: -  realmats - A and B are real

    1325:    Options Database Keys:
    1326: +  -eps_ciss_integration_points - Sets the number of integration points
    1327: .  -eps_ciss_blocksize - Sets the block size
    1328: .  -eps_ciss_moments - Sets the moment size
    1329: .  -eps_ciss_partitions - Sets the number of partitions
    1330: .  -eps_ciss_maxblocksize - Sets the maximum block size
    1331: -  -eps_ciss_realmats - A and B are real

    1333:    Note:
    1334:    The default number of partitions is 1. This means the internal KSP object is shared
    1335:    among all processes of the EPS communicator. Otherwise, the communicator is split
    1336:    into npart communicators, so that npart KSP solves proceed simultaneously.

    1338:    Level: advanced

    1340: .seealso: EPSCISSGetSizes()
    1341: @*/
    1342: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool realmats)
    1343: {

    1354:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,realmats));
    1355:   return(0);
    1356: }

    1358: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
    1359: {
    1360:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1363:   if (ip) *ip = ctx->N;
    1364:   if (bs) *bs = ctx->L;
    1365:   if (ms) *ms = ctx->M;
    1366:   if (npart) *npart = ctx->npart;
    1367:   if (bsmax) *bsmax = ctx->L_max;
    1368:   if (realmats) *realmats = ctx->isreal;
    1369:   return(0);
    1370: }

    1372: /*@
    1373:    EPSCISSGetSizes - Gets the values of various size parameters in the CISS solver.

    1375:    Not Collective

    1377:    Input Parameter:
    1378: .  eps - the eigenproblem solver context

    1380:    Output Parameters:
    1381: +  ip    - number of integration points
    1382: .  bs    - block size
    1383: .  ms    - moment size
    1384: .  npart - number of partitions when splitting the communicator
    1385: .  bsmax - max block size
    1386: -  realmats - A and B are real

    1388:    Level: advanced

    1390: .seealso: EPSCISSSetSizes()
    1391: @*/
    1392: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *realmats)
    1393: {

    1398:   PetscUseMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,realmats));
    1399:   return(0);
    1400: }

    1402: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
    1403: {
    1404:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1407:   if (delta == PETSC_DEFAULT) {
    1408:     ctx->delta = 1e-12;
    1409:   } else {
    1410:     if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
    1411:     ctx->delta = delta;
    1412:   }
    1413:   if (spur == PETSC_DEFAULT) {
    1414:     ctx->spurious_threshold = 1e-4;
    1415:   } else {
    1416:     if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
    1417:     ctx->spurious_threshold = spur;
    1418:   }
    1419:   return(0);
    1420: }

    1422: /*@
    1423:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
    1424:    the CISS solver.

    1426:    Logically Collective on eps

    1428:    Input Parameters:
    1429: +  eps   - the eigenproblem solver context
    1430: .  delta - threshold for numerical rank
    1431: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1433:    Options Database Keys:
    1434: +  -eps_ciss_delta - Sets the delta
    1435: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

    1437:    Level: advanced

    1439: .seealso: EPSCISSGetThreshold()
    1440: @*/
    1441: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
    1442: {

    1449:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
    1450:   return(0);
    1451: }

    1453: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
    1454: {
    1455:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1458:   if (delta) *delta = ctx->delta;
    1459:   if (spur)  *spur = ctx->spurious_threshold;
    1460:   return(0);
    1461: }

    1463: /*@
    1464:    EPSCISSGetThreshold - Gets the values of various threshold parameters
    1465:    in the CISS solver.

    1467:    Not Collective

    1469:    Input Parameter:
    1470: .  eps - the eigenproblem solver context

    1472:    Output Parameters:
    1473: +  delta - threshold for numerical rank
    1474: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1476:    Level: advanced

    1478: .seealso: EPSCISSSetThreshold()
    1479: @*/
    1480: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
    1481: {

    1486:   PetscUseMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
    1487:   return(0);
    1488: }

    1490: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt blsize)
    1491: {
    1492:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1495:   if (inner == PETSC_DEFAULT) {
    1496:     ctx->refine_inner = 0;
    1497:   } else {
    1498:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
    1499:     ctx->refine_inner = inner;
    1500:   }
    1501:   if (blsize == PETSC_DEFAULT) {
    1502:     ctx->refine_blocksize = 0;
    1503:   } else {
    1504:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
    1505:     ctx->refine_blocksize = blsize;
    1506:   }
    1507:   return(0);
    1508: }

    1510: /*@
    1511:    EPSCISSSetRefinement - Sets the values of various refinement parameters
    1512:    in the CISS solver.

    1514:    Logically Collective on eps

    1516:    Input Parameters:
    1517: +  eps    - the eigenproblem solver context
    1518: .  inner  - number of iterative refinement iterations (inner loop)
    1519: -  blsize - number of iterative refinement iterations (blocksize loop)

    1521:    Options Database Keys:
    1522: +  -eps_ciss_refine_inner - Sets number of inner iterations
    1523: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

    1525:    Level: advanced

    1527: .seealso: EPSCISSGetRefinement()
    1528: @*/
    1529: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt blsize)
    1530: {

    1537:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt),(eps,inner,blsize));
    1538:   return(0);
    1539: }

    1541: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *blsize)
    1542: {
    1543:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1546:   if (inner)  *inner = ctx->refine_inner;
    1547:   if (blsize) *blsize = ctx->refine_blocksize;
    1548:   return(0);
    1549: }

    1551: /*@
    1552:    EPSCISSGetRefinement - Gets the values of various refinement parameters
    1553:    in the CISS solver.

    1555:    Not Collective

    1557:    Input Parameter:
    1558: .  eps - the eigenproblem solver context

    1560:    Output Parameters:
    1561: +  inner  - number of iterative refinement iterations (inner loop)
    1562: -  blsize - number of iterative refinement iterations (blocksize loop)

    1564:    Level: advanced

    1566: .seealso: EPSCISSSetRefinement()
    1567: @*/
    1568: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *blsize)
    1569: {

    1574:   PetscUseMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*),(eps,inner,blsize));
    1575:   return(0);
    1576: }

    1578: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
    1579: {
    1580:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1583:   ctx->usest     = usest;
    1584:   ctx->usest_set = PETSC_TRUE;
    1585:   eps->state     = EPS_STATE_INITIAL;
    1586:   return(0);
    1587: }

    1589: /*@
    1590:    EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
    1591:    use the ST object for the linear solves.

    1593:    Logically Collective on eps

    1595:    Input Parameters:
    1596: +  eps    - the eigenproblem solver context
    1597: -  usest  - boolean flag to use the ST object or not

    1599:    Options Database Keys:
    1600: .  -eps_ciss_usest <bool> - whether the ST object will be used or not

    1602:    Level: advanced

    1604: .seealso: EPSCISSGetUseST()
    1605: @*/
    1606: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
    1607: {

    1613:   PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
    1614:   return(0);
    1615: }

    1617: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
    1618: {
    1619:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1622:   *usest = ctx->usest;
    1623:   return(0);
    1624: }

    1626: /*@
    1627:    EPSCISSGetUseST - Gets the flag for using the ST object
    1628:    in the CISS solver.

    1630:    Not Collective

    1632:    Input Parameter:
    1633: .  eps - the eigenproblem solver context

    1635:    Output Parameters:
    1636: .  usest - boolean flag indicating if the ST object is being used

    1638:    Level: advanced

    1640: .seealso: EPSCISSSetUseST()
    1641: @*/
    1642: PetscErrorCode EPSCISSGetUseST(EPS eps,PetscBool *usest)
    1643: {

    1649:   PetscUseMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
    1650:   return(0);
    1651: }

    1653: static PetscErrorCode EPSCISSSetQuadRule_CISS(EPS eps,EPSCISSQuadRule quad)
    1654: {
    1655:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1658:   ctx->quad = quad;
    1659:   return(0);
    1660: }

    1662: /*@
    1663:    EPSCISSSetQuadRule - Sets the quadrature rule used in the CISS solver.

    1665:    Logically Collective on eps

    1667:    Input Parameters:
    1668: +  eps  - the eigenproblem solver context
    1669: -  quad - the quadrature rule

    1671:    Options Database Key:
    1672: .  -eps_ciss_quadrule - Sets the quadrature rule (either 'trapezoidal' or
    1673:                            'chebyshev')

    1675:    Notes:
    1676:    By default, the trapezoidal rule is used (EPS_CISS_QUADRULE_TRAPEZOIDAL).

    1678:    If the 'chebyshev' option is specified (EPS_CISS_QUADRULE_CHEBYSHEV), then
    1679:    Chebyshev points are used as quadrature points.

    1681:    Level: advanced

    1683: .seealso: EPSCISSGetQuadRule(), EPSCISSQuadRule
    1684: @*/
    1685: PetscErrorCode EPSCISSSetQuadRule(EPS eps,EPSCISSQuadRule quad)
    1686: {

    1692:   PetscTryMethod(eps,"EPSCISSSetQuadRule_C",(EPS,EPSCISSQuadRule),(eps,quad));
    1693:   return(0);
    1694: }

    1696: static PetscErrorCode EPSCISSGetQuadRule_CISS(EPS eps,EPSCISSQuadRule *quad)
    1697: {
    1698:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1701:   *quad = ctx->quad;
    1702:   return(0);
    1703: }

    1705: /*@
    1706:    EPSCISSGetQuadRule - Gets the quadrature rule used in the CISS solver.

    1708:    Not Collective

    1710:    Input Parameter:
    1711: .  eps - the eigenproblem solver context

    1713:    Output Parameters:
    1714: .  quad - quadrature rule

    1716:    Level: advanced

    1718: .seealso: EPSCISSSetQuadRule() EPSCISSQuadRule
    1719: @*/
    1720: PetscErrorCode EPSCISSGetQuadRule(EPS eps,EPSCISSQuadRule *quad)
    1721: {

    1727:   PetscUseMethod(eps,"EPSCISSGetQuadRule_C",(EPS,EPSCISSQuadRule*),(eps,quad));
    1728:   return(0);
    1729: }

    1731: static PetscErrorCode EPSCISSSetExtraction_CISS(EPS eps,EPSCISSExtraction extraction)
    1732: {
    1733:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1736:   ctx->extraction = extraction;
    1737:   return(0);
    1738: }

    1740: /*@
    1741:    EPSCISSSetExtraction - Sets the extraction technique used in the CISS solver.

    1743:    Logically Collective on eps

    1745:    Input Parameters:
    1746: +  eps        - the eigenproblem solver context
    1747: -  extraction - the extraction technique

    1749:    Options Database Key:
    1750: .  -eps_ciss_extraction - Sets the extraction technique (either 'ritz' or
    1751:                            'hankel')

    1753:    Notes:
    1754:    By default, the Rayleigh-Ritz extraction is used (EPS_CISS_EXTRACTION_RITZ).

    1756:    If the 'hankel' option is specified (EPS_CISS_EXTRACTION_HANKEL), then
    1757:    the Block Hankel method is used for extracting eigenpairs.

    1759:    Level: advanced

    1761: .seealso: EPSCISSGetExtraction(), EPSCISSExtraction
    1762: @*/
    1763: PetscErrorCode EPSCISSSetExtraction(EPS eps,EPSCISSExtraction extraction)
    1764: {

    1770:   PetscTryMethod(eps,"EPSCISSSetExtraction_C",(EPS,EPSCISSExtraction),(eps,extraction));
    1771:   return(0);
    1772: }

    1774: static PetscErrorCode EPSCISSGetExtraction_CISS(EPS eps,EPSCISSExtraction *extraction)
    1775: {
    1776:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1779:   *extraction = ctx->extraction;
    1780:   return(0);
    1781: }

    1783: /*@
    1784:    EPSCISSGetExtraction - Gets the extraction technique used in the CISS solver.

    1786:    Not Collective

    1788:    Input Parameter:
    1789: .  eps - the eigenproblem solver context

    1791:    Output Parameters:
    1792: .  extraction - extraction technique

    1794:    Level: advanced

    1796: .seealso: EPSCISSSetExtraction() EPSCISSExtraction
    1797: @*/
    1798: PetscErrorCode EPSCISSGetExtraction(EPS eps,EPSCISSExtraction *extraction)
    1799: {

    1805:   PetscUseMethod(eps,"EPSCISSGetExtraction_C",(EPS,EPSCISSExtraction*),(eps,extraction));
    1806:   return(0);
    1807: }

    1809: static PetscErrorCode EPSCISSGetKSPs_CISS(EPS eps,PetscInt *nsolve,KSP **ksp)
    1810: {
    1812:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1813:   PetscInt       i;
    1814:   PC             pc;

    1817:   if (!ctx->ksp) {
    1818:     if (!ctx->subcomm) {  /* initialize subcomm first */
    1819:       EPSCISSSetUseConj(eps,&ctx->useconj);
    1820:       EPSCISSSetUpSubComm(eps,&ctx->num_solve_point);
    1821:     }
    1822:     PetscMalloc1(ctx->num_solve_point,&ctx->ksp);
    1823:     for (i=0;i<ctx->num_solve_point;i++) {
    1824:       KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
    1825:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
    1826:       KSPSetOptionsPrefix(ctx->ksp[i],((PetscObject)eps)->prefix);
    1827:       KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
    1828:       PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->ksp[i]);
    1829:       PetscObjectSetOptions((PetscObject)ctx->ksp[i],((PetscObject)eps)->options);
    1830:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
    1831:       KSPSetTolerances(ctx->ksp[i],SLEPC_DEFAULT_TOL,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
    1832:       KSPGetPC(ctx->ksp[i],&pc);
    1833:       KSPSetType(ctx->ksp[i],KSPPREONLY);
    1834:       PCSetType(pc,PCLU);
    1835:     }
    1836:   }
    1837:   if (nsolve) *nsolve = ctx->num_solve_point;
    1838:   if (ksp)    *ksp    = ctx->ksp;
    1839:   return(0);
    1840: }

    1842: /*@C
    1843:    EPSCISSGetKSPs - Retrieve the array of linear solver objects associated with
    1844:    the CISS solver.

    1846:    Not Collective

    1848:    Input Parameter:
    1849: .  eps - the eigenproblem solver solver

    1851:    Output Parameters:
    1852: +  nsolve - number of solver objects
    1853: -  ksp - array of linear solver object

    1855:    Notes:
    1856:    The number of KSP solvers is equal to the number of integration points divided by
    1857:    the number of partitions. This value is halved in the case of real matrices with
    1858:    a region centered at the real axis.

    1860:    Level: advanced

    1862: .seealso: EPSCISSSetSizes()
    1863: @*/
    1864: PetscErrorCode EPSCISSGetKSPs(EPS eps,PetscInt *nsolve,KSP **ksp)
    1865: {

    1870:   PetscUseMethod(eps,"EPSCISSGetKSPs_C",(EPS,PetscInt*,KSP**),(eps,nsolve,ksp));
    1871:   return(0);
    1872: }

    1874: PetscErrorCode EPSReset_CISS(EPS eps)
    1875: {
    1877:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1878:   PetscInt       i;

    1881:   BVDestroy(&ctx->S);
    1882:   BVDestroy(&ctx->V);
    1883:   BVDestroy(&ctx->Y);
    1884:   if (!ctx->usest) {
    1885:     for (i=0;i<ctx->num_solve_point;i++) {
    1886:       KSPReset(ctx->ksp[i]);
    1887:     }
    1888:   }
    1889:   VecScatterDestroy(&ctx->scatterin);
    1890:   VecDestroy(&ctx->xsub);
    1891:   VecDestroy(&ctx->xdup);
    1892:   if (ctx->pA) {
    1893:     MatDestroy(&ctx->pA);
    1894:     MatDestroy(&ctx->pB);
    1895:     BVDestroy(&ctx->pV);
    1896:   }
    1897:   return(0);
    1898: }

    1900: PetscErrorCode EPSSetFromOptions_CISS(PetscOptionItems *PetscOptionsObject,EPS eps)
    1901: {
    1902:   PetscErrorCode    ierr;
    1903:   PetscReal         r3,r4;
    1904:   PetscInt          i,i1,i2,i3,i4,i5,i6,i7;
    1905:   PetscBool         b1,b2,flg;
    1906:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
    1907:   EPSCISSQuadRule   quad;
    1908:   EPSCISSExtraction extraction;

    1911:   PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");

    1913:     EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
    1914:     PetscOptionsInt("-eps_ciss_integration_points","Number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
    1915:     PetscOptionsInt("-eps_ciss_blocksize","Block size","EPSCISSSetSizes",i2,&i2,NULL);
    1916:     PetscOptionsInt("-eps_ciss_moments","Moment size","EPSCISSSetSizes",i3,&i3,NULL);
    1917:     PetscOptionsInt("-eps_ciss_partitions","Number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
    1918:     PetscOptionsInt("-eps_ciss_maxblocksize","Maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
    1919:     PetscOptionsBool("-eps_ciss_realmats","True if A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
    1920:     EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

    1922:     EPSCISSGetThreshold(eps,&r3,&r4);
    1923:     PetscOptionsReal("-eps_ciss_delta","Threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
    1924:     PetscOptionsReal("-eps_ciss_spurious_threshold","Threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
    1925:     EPSCISSSetThreshold(eps,r3,r4);

    1927:     EPSCISSGetRefinement(eps,&i6,&i7);
    1928:     PetscOptionsInt("-eps_ciss_refine_inner","Number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
    1929:     PetscOptionsInt("-eps_ciss_refine_blocksize","Number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
    1930:     EPSCISSSetRefinement(eps,i6,i7);

    1932:     EPSCISSGetUseST(eps,&b2);
    1933:     PetscOptionsBool("-eps_ciss_usest","Use ST for linear solves","EPSCISSSetUseST",b2,&b2,&flg);
    1934:     if (flg) { EPSCISSSetUseST(eps,b2); }

    1936:     PetscOptionsEnum("-eps_ciss_quadrule","Quadrature rule","EPSCISSSetQuadRule",EPSCISSQuadRules,(PetscEnum)ctx->quad,(PetscEnum*)&quad,&flg);
    1937:     if (flg) { EPSCISSSetQuadRule(eps,quad); }

    1939:     PetscOptionsEnum("-eps_ciss_extraction","Extraction technique","EPSCISSSetExtraction",EPSCISSExtractions,(PetscEnum)ctx->extraction,(PetscEnum*)&extraction,&flg);
    1940:     if (flg) { EPSCISSSetExtraction(eps,extraction); }

    1942:   PetscOptionsTail();

    1944:   if (!eps->rg) { EPSGetRG(eps,&eps->rg); }
    1945:   RGSetFromOptions(eps->rg); /* this is necessary here to set useconj */
    1946:   if (!ctx->ksp) { EPSCISSGetKSPs(eps,&ctx->num_solve_point,&ctx->ksp); }
    1947:   for (i=0;i<ctx->num_solve_point;i++) {
    1948:     KSPSetFromOptions(ctx->ksp[i]);
    1949:   }
    1950:   PetscSubcommSetFromOptions(ctx->subcomm);
    1951:   return(0);
    1952: }

    1954: PetscErrorCode EPSDestroy_CISS(EPS eps)
    1955: {
    1957:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    1960:   EPSCISSResetSubcomm(eps);
    1961:   PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
    1962:   PetscFree(eps->data);
    1963:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
    1964:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
    1965:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
    1966:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
    1967:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
    1968:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
    1969:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
    1970:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
    1971:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",NULL);
    1972:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",NULL);
    1973:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",NULL);
    1974:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",NULL);
    1975:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",NULL);
    1976:   return(0);
    1977: }

    1979: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
    1980: {
    1982:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1983:   PetscBool      isascii;

    1986:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    1987:   if (isascii) {
    1988:     PetscViewerASCIIPrintf(viewer,"  sizes { integration points: %D, block size: %D, moment size: %D, partitions: %D, maximum block size: %D }\n",ctx->N,ctx->L,ctx->M,ctx->npart,ctx->L_max);
    1989:     if (ctx->isreal) {
    1990:       PetscViewerASCIIPrintf(viewer,"  exploiting symmetry of integration points\n");
    1991:     }
    1992:     PetscViewerASCIIPrintf(viewer,"  threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
    1993:     PetscViewerASCIIPrintf(viewer,"  iterative refinement { inner: %D, blocksize: %D }\n",ctx->refine_inner, ctx->refine_blocksize);
    1994:     PetscViewerASCIIPrintf(viewer,"  extraction: %s\n",EPSCISSExtractions[ctx->extraction]);
    1995:     PetscViewerASCIIPrintf(viewer,"  quadrature rule: %s\n",EPSCISSQuadRules[ctx->quad]);
    1996:     if (ctx->usest) {
    1997:       PetscViewerASCIIPrintf(viewer,"  using ST for linear solves\n");
    1998:     } else {
    1999:       if (!ctx->ksp) { EPSCISSGetKSPs(eps,&ctx->num_solve_point,&ctx->ksp); }
    2000:       PetscViewerASCIIPushTab(viewer);
    2001:       KSPView(ctx->ksp[0],viewer);
    2002:       PetscViewerASCIIPopTab(viewer);
    2003:     }
    2004:   }
    2005:   return(0);
    2006: }

    2008: PetscErrorCode EPSSetDefaultST_CISS(EPS eps)
    2009: {
    2011:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    2012:   PetscBool      usest = ctx->usest;

    2015:   if (!((PetscObject)eps->st)->type_name) {
    2016:     if (!ctx->usest_set) usest = (ctx->npart>1)? PETSC_FALSE: PETSC_TRUE;
    2017:     if (usest) {
    2018:       STSetType(eps->st,STSINVERT);
    2019:     } else {
    2020:       /* we are not going to use ST, so avoid factorizing the matrix */
    2021:       STSetType(eps->st,STSHIFT);
    2022:     }
    2023:   }
    2024:   return(0);
    2025: }

    2027: SLEPC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
    2028: {
    2030:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    2033:   PetscNewLog(eps,&ctx);
    2034:   eps->data = ctx;

    2036:   eps->useds = PETSC_TRUE;
    2037:   eps->categ = EPS_CATEGORY_CONTOUR;

    2039:   eps->ops->solve          = EPSSolve_CISS;
    2040:   eps->ops->setup          = EPSSetUp_CISS;
    2041:   eps->ops->setupsort      = EPSSetUpSort_CISS;
    2042:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
    2043:   eps->ops->destroy        = EPSDestroy_CISS;
    2044:   eps->ops->reset          = EPSReset_CISS;
    2045:   eps->ops->view           = EPSView_CISS;
    2046:   eps->ops->computevectors = EPSComputeVectors_CISS;
    2047:   eps->ops->setdefaultst   = EPSSetDefaultST_CISS;

    2049:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
    2050:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
    2051:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
    2052:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
    2053:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
    2054:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
    2055:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
    2056:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
    2057:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetQuadRule_C",EPSCISSSetQuadRule_CISS);
    2058:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetQuadRule_C",EPSCISSGetQuadRule_CISS);
    2059:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetExtraction_C",EPSCISSSetExtraction_CISS);
    2060:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetExtraction_C",EPSCISSGetExtraction_CISS);
    2061:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetKSPs_C",EPSCISSGetKSPs_CISS);

    2063:   /* log events */
    2064:   PetscLogEventRegister("EPSCISS_SVD",EPS_CLASSID,&EPS_CISS_SVD);

    2066:   /* set default values of parameters */
    2067:   ctx->N                  = 32;
    2068:   ctx->L                  = 16;
    2069:   ctx->M                  = ctx->N/4;
    2070:   ctx->delta              = 1e-12;
    2071:   ctx->L_max              = 64;
    2072:   ctx->spurious_threshold = 1e-4;
    2073:   ctx->usest              = PETSC_TRUE;
    2074:   ctx->usest_set          = PETSC_FALSE;
    2075:   ctx->isreal             = PETSC_FALSE;
    2076:   ctx->refine_inner       = 0;
    2077:   ctx->refine_blocksize   = 0;
    2078:   ctx->npart              = 1;
    2079:   ctx->quad               = (EPSCISSQuadRule)0;
    2080:   ctx->extraction         = EPS_CISS_EXTRACTION_RITZ;
    2081:   return(0);
    2082: }