Date: 2015-09-03T15:04:54+00:00

Actual source code: ciss.c
slepc-3.6.1 2015-09-03
Report Typos and Errors

      1: /*

      3:    SLEPc eigensolver: "ciss"

      5:    Method: Contour Integral Spectral Slicing

      7:    Algorithm:

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

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

     15:    References:

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

     20:        [2] T. Sakurai and H. Tadano, "CIRR: a Rayleigh-Ritz type method with
     21:            contour integral for generalized eigenvalue problems", Hokkaido
     22:            Math. J. 36:745-757, 2007.

     24:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     25:    SLEPc - Scalable Library for Eigenvalue Problem Computations
     26:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

     28:    This file is part of SLEPc.

     30:    SLEPc is free software: you can redistribute it and/or modify it under  the
     31:    terms of version 3 of the GNU Lesser General Public License as published by
     32:    the Free Software Foundation.

     34:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     35:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     36:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     37:    more details.

     39:    You  should have received a copy of the GNU Lesser General  Public  License
     40:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     41:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     42: */

     44: #include <slepc/private/epsimpl.h>                /*I "slepceps.h" I*/
     45: #include <slepcblaslapack.h>

     47: PetscErrorCode EPSSolve_CISS(EPS);

     49: typedef struct {
     50:   /* parameters */
     51:   PetscInt    N;          /* number of integration points (32) */
     52:   PetscInt    L;          /* block size (16) */
     53:   PetscInt    M;          /* moment degree (N/4 = 4) */
     54:   PetscReal   delta;      /* threshold of singular value (1e-12) */
     55:   PetscInt    L_max;      /* maximum number of columns of the source matrix V */
     56:   PetscReal   spurious_threshold; /* discard spurious eigenpairs */
     57:   PetscBool   isreal;     /* A and B are real */
     58:   PetscInt    refine_inner;
     59:   PetscInt    refine_outer;
     60:   PetscInt    refine_blocksize;
     61:   /* private data */
     62:   PetscReal    *sigma;     /* threshold for numerical rank */
     63:   PetscInt     num_subcomm;
     64:   PetscInt     subcomm_id;
     65:   PetscInt     num_solve_point;
     66:   PetscScalar  *weight;
     67:   PetscScalar  *omega;
     68:   PetscScalar  *pp;
     69:   BV           V;
     70:   BV           S;
     71:   BV           pV;
     72:   BV           Y;
     73:   Vec          xsub;
     74:   Vec          xdup;
     75:   KSP          *ksp;
     76:   Mat          *kspMat;
     77:   PetscBool    useconj;
     78:   PetscReal    est_eig;
     79:   VecScatter   scatterin;
     80:   Mat          pA,pB;
     81:   PetscSubcomm subcomm;
     82:   PetscBool    usest;
     83: } EPS_CISS;

     87: static PetscErrorCode SetSolverComm(EPS eps)
     88: {
     90:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
     91:   PetscInt       N = ctx->N;

     94:   if (ctx->useconj) N = N/2;
     95:   if (!ctx->subcomm) {
     96:     PetscSubcommCreate(PetscObjectComm((PetscObject)eps),&ctx->subcomm);
     97:     PetscSubcommSetNumber(ctx->subcomm,ctx->num_subcomm);
     98:     PetscSubcommSetType(ctx->subcomm,PETSC_SUBCOMM_INTERLACED);
     99:     PetscLogObjectMemory((PetscObject)eps,sizeof(PetscSubcomm));
    100:     PetscSubcommSetFromOptions(ctx->subcomm);
    101:   }
    102:   ctx->subcomm_id = ctx->subcomm->color;
    103:   ctx->num_solve_point = N / ctx->num_subcomm;
    104:   if ((N%ctx->num_subcomm) > ctx->subcomm_id) ctx->num_solve_point+=1;
    105:   return(0);
    106: }

    110: static PetscErrorCode CISSRedundantMat(EPS eps)
    111: {
    113:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    114:   Mat            A,B;
    115:   PetscInt       nmat;

    118:   STGetNumMatrices(eps->st,&nmat);
    119:   if (ctx->subcomm->n != 1) {
    120:     STGetOperators(eps->st,0,&A);
    121:     MatCreateRedundantMatrix(A,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pA);
    122:     if (nmat>1) {
    123:       STGetOperators(eps->st,1,&B);
    124:       MatCreateRedundantMatrix(B,ctx->subcomm->n,PetscSubcommChild(ctx->subcomm),MAT_INITIAL_MATRIX,&ctx->pB);
    125:     } else ctx->pB = NULL;
    126:   } else {
    127:     ctx->pA = NULL;
    128:     ctx->pB = NULL;
    129:   }
    130:   return(0);
    131: }

    135: static PetscErrorCode CISSScatterVec(EPS eps)
    136: {
    138:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    139:   IS             is1,is2;
    140:   Vec            v0;
    141:   PetscInt       i,j,k,mstart,mend,mlocal;
    142:   PetscInt       *idx1,*idx2,mloc_sub;

    145:   MatCreateVecs(ctx->pA,&ctx->xsub,NULL);
    146:   MatGetLocalSize(ctx->pA,&mloc_sub,NULL);
    147:   VecCreateMPI(PetscSubcommContiguousParent(ctx->subcomm),mloc_sub,PETSC_DECIDE,&ctx->xdup);
    148:   if (!ctx->scatterin) {
    149:     BVGetColumn(ctx->V,0,&v0);
    150:     VecGetOwnershipRange(v0,&mstart,&mend);
    151:     mlocal = mend - mstart;
    152:     PetscMalloc2(ctx->subcomm->n*mlocal,&idx1,ctx->subcomm->n*mlocal,&idx2);
    153:     j = 0;
    154:     for (k=0;k<ctx->subcomm->n;k++) {
    155:       for (i=mstart;i<mend;i++) {
    156:         idx1[j]   = i;
    157:         idx2[j++] = i + eps->n*k;
    158:       }
    159:     }
    160:     ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx1,PETSC_COPY_VALUES,&is1);
    161:     ISCreateGeneral(PetscObjectComm((PetscObject)eps),ctx->subcomm->n*mlocal,idx2,PETSC_COPY_VALUES,&is2);
    162:     VecScatterCreate(v0,is1,ctx->xdup,is2,&ctx->scatterin);
    163:     ISDestroy(&is1);
    164:     ISDestroy(&is2);
    165:     PetscFree2(idx1,idx2);
    166:     BVRestoreColumn(ctx->V,0,&v0);
    167:   }
    168:   return(0);
    169: }

    173: static PetscErrorCode SetPathParameter(EPS eps)
    174: {
    176:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    177:   PetscInt       i;
    178:   PetscScalar    center;
    179:   PetscReal      theta,radius,vscale,start_ang,end_ang,width;
    180:   PetscBool      isring=PETSC_FALSE,isellipse=PETSC_FALSE;

    183:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    184:   if (isellipse) {
    185:     RGEllipseGetParameters(eps->rg,&center,&radius,&vscale);
    186:   } else {
    187:     PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
    188:     if (!isring) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Region must be Ellipse or Ring");
    189:     RGRingGetParameters(eps->rg,&center,&radius,&vscale,&start_ang,&end_ang,&width);
    190:   }
    191:   for (i=0;i<ctx->N;i++) {
    192:     if (isring) {
    193:       /* Ring region only supported for complex scalars */
    194: #if defined(PETSC_USE_COMPLEX)
    195:       theta = (PETSC_PI/ctx->N)*(i+0.5);
    196:       ctx->pp[i] = PetscCosReal(theta);
    197:       ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
    198:       theta = (start_ang*2+(end_ang-start_ang)*(PetscCosReal(theta)+1.0))*PETSC_PI;
    199:       ctx->omega[i] = center + radius*(PetscCosReal(theta)+PETSC_i*vscale*PetscSinReal(theta));
    200: #endif
    201:     } else {
    202: #if defined(PETSC_USE_COMPLEX)
    203:       theta = ((2*PETSC_PI)/ctx->N)*(i+0.5);
    204:       ctx->pp[i] = PetscCosReal(theta) + PETSC_i*vscale*PetscSinReal(theta);
    205:       ctx->weight[i] = radius*(vscale*PetscCosReal(theta) + PETSC_i*PetscSinReal(theta))/(PetscReal)ctx->N;
    206:       ctx->omega[i] = center + radius*ctx->pp[i];
    207: #else
    208:       theta = (PETSC_PI/ctx->N)*(i+0.5);
    209:       ctx->pp[i] = PetscCosReal(theta);
    210:       ctx->weight[i] = PetscCosReal((ctx->N-1)*theta)/ctx->N;
    211:       ctx->omega[i] = center + radius*ctx->pp[i];
    212: #endif
    213:     }
    214:   }
    215:   return(0);
    216: }

    220: static PetscErrorCode CISSVecSetRandom(BV V,PetscInt i0,PetscInt i1,PetscRandom rctx)
    221: {
    223:   PetscInt       i,j,nlocal;
    224:   PetscScalar    *vdata;
    225:   Vec            x;
    226:
    228:   BVGetSizes(V,&nlocal,NULL,NULL);
    229:   for (i=i0;i<i1;i++) {
    230:     BVSetRandomColumn(V,i,rctx);
    231:     BVGetColumn(V,i,&x);
    232:     VecGetArray(x,&vdata);
    233:     for (j=0;j<nlocal;j++) {
    234:       vdata[j] = PetscRealPart(vdata[j]);
    235:       if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
    236:       else vdata[j] = 1.0;
    237:     }
    238:     VecRestoreArray(x,&vdata);
    239:     BVRestoreColumn(V,i,&x);
    240:   }
    241:   return(0);
    242: }

    246: static PetscErrorCode VecScatterVecs(EPS eps,BV Vin,PetscInt n)
    247: {
    248:   PetscErrorCode    ierr;
    249:   EPS_CISS          *ctx = (EPS_CISS*)eps->data;
    250:   PetscInt          i;
    251:   Vec               vi,pvi;
    252:   const PetscScalar *array;

    255:   for (i=0;i<n;i++) {
    256:     BVGetColumn(Vin,i,&vi);
    257:     VecScatterBegin(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
    258:     VecScatterEnd(ctx->scatterin,vi,ctx->xdup,INSERT_VALUES,SCATTER_FORWARD);
    259:     BVRestoreColumn(Vin,i,&vi);
    260:     VecGetArrayRead(ctx->xdup,&array);
    261:     VecPlaceArray(ctx->xsub,array);
    262:     BVGetColumn(ctx->pV,i,&pvi);
    263:     VecCopy(ctx->xsub,pvi);
    264:     BVRestoreColumn(ctx->pV,i,&pvi);
    265:     VecResetArray(ctx->xsub);
    266:     VecRestoreArrayRead(ctx->xdup,&array);
    267:   }
    268:   return(0);
    269: }

    273: static PetscErrorCode SolveLinearSystem(EPS eps,Mat A,Mat B,BV V,PetscInt L_start,PetscInt L_end,PetscBool initksp)
    274: {
    276:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    277:   PetscInt       i,j,p_id;
    278:   Mat            Fz;
    279:   PC             pc;
    280:   Vec            Bvj,vj,yj;
    281:   KSP            ksp;

    284:   BVCreateVec(V,&Bvj);
    285:   if (ctx->usest) {
    286:     MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
    287:   }
    288:   if (ctx->usest && ctx->pA) {
    289:     KSPCreate(PetscSubcommChild(ctx->subcomm),&ksp);
    290:   }
    291:   for (i=0;i<ctx->num_solve_point;i++) {
    292:     p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    293:     if (!ctx->usest && initksp == PETSC_TRUE) {
    294:       MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&ctx->kspMat[i]);
    295:       MatCopy(A,ctx->kspMat[i],DIFFERENT_NONZERO_PATTERN);
    296:       if (B) {
    297:         MatAXPY(ctx->kspMat[i],-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
    298:       } else {
    299:         MatShift(ctx->kspMat[i],-ctx->omega[p_id]);
    300:       }
    301:       KSPSetOperators(ctx->ksp[i],ctx->kspMat[i],ctx->kspMat[i]);
    302:       KSPSetType(ctx->ksp[i],KSPPREONLY);
    303:       KSPGetPC(ctx->ksp[i],&pc);
    304:       PCSetType(pc,PCREDUNDANT);
    305:       KSPSetFromOptions(ctx->ksp[i]);
    306:     } else if (ctx->usest && ctx->pA) {
    307:       MatCopy(A,Fz,DIFFERENT_NONZERO_PATTERN);
    308:       if (B) {
    309:         MatAXPY(Fz,-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
    310:       } else {
    311:         MatShift(Fz,-ctx->omega[p_id]);
    312:       }
    313:       KSPSetOperators(ksp,Fz,Fz);
    314:       KSPSetType(ksp,KSPPREONLY);
    315:       KSPGetPC(ksp,&pc);
    316:       PCSetType(pc,PCREDUNDANT);
    317:       KSPSetFromOptions(ksp);
    318:     } else if (ctx->usest && !ctx->pA) {
    319:       STSetShift(eps->st,ctx->omega[p_id]);
    320:       STGetKSP(eps->st,&ksp);
    321:     }
    322:
    323:     for (j=L_start;j<L_end;j++) {
    324:       BVGetColumn(V,j,&vj);
    325:       BVGetColumn(ctx->Y,i*ctx->L_max+j,&yj);
    326:       if (B) {
    327:         MatMult(B,vj,Bvj);
    328:         if (ctx->usest) {
    329:           KSPSolve(ksp,Bvj,yj);
    330:         } else {
    331:           KSPSolve(ctx->ksp[i],Bvj,yj);
    332:         }
    333:       } else {
    334:         if (ctx->usest) {
    335:           KSPSolve(ksp,vj,yj);
    336:         } else {
    337:           KSPSolve(ctx->ksp[i],vj,yj);
    338:         }
    339:       }
    340:       BVRestoreColumn(V,j,&vj);
    341:       BVRestoreColumn(ctx->Y,i*ctx->L_max+j,&yj);
    342:     }
    343:     if (ctx->usest && i<ctx->num_solve_point-1) {  KSPReset(ksp); }
    344:   }
    345:   if (ctx->usest) { MatDestroy(&Fz); }
    346:   VecDestroy(&Bvj);
    347:   if (ctx->usest && ctx->pA) {
    348:     KSPDestroy(&ksp);
    349:   }
    350:   return(0);
    351: }

    353: #if defined(PETSC_USE_COMPLEX)
    356: static PetscErrorCode EstimateNumberEigs(EPS eps,PetscInt *L_add)
    357: {
    359:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    360:   PetscInt       i,j,p_id;
    361:   PetscScalar    tmp,m = 1,sum = 0.0;
    362:   PetscReal      eta;
    363:   Vec            v,vtemp,vj,yj;

    366:   BVGetColumn(ctx->Y,0,&yj);
    367:   VecDuplicate(yj,&v);
    368:   BVRestoreColumn(ctx->Y,0,&yj);
    369:   BVCreateVec(ctx->V,&vtemp);
    370:   for (j=0;j<ctx->L;j++) {
    371:     VecSet(v,0);
    372:     for (i=0;i<ctx->num_solve_point; i++) {
    373:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    374:       BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
    375:       BVMultVec(ctx->Y,ctx->weight[p_id],1,v,&m);
    376:     }
    377:     BVGetColumn(ctx->V,j,&vj);
    378:     if (ctx->pA) {
    379:       VecSet(vtemp,0);
    380:       VecScatterBegin(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
    381:       VecScatterEnd(ctx->scatterin,v,vtemp,ADD_VALUES,SCATTER_REVERSE);
    382:       VecDot(vj,vtemp,&tmp);
    383:     } else {
    384:       VecDot(vj,v,&tmp);
    385:     }
    386:     BVRestoreColumn(ctx->V,j,&vj);
    387:     if (ctx->useconj) sum += PetscRealPart(tmp)*2;
    388:     else sum += tmp;
    389:   }
    390:   ctx->est_eig = PetscAbsScalar(sum/(PetscReal)ctx->L);
    391:   eta = PetscPowReal(10.0,-PetscLog10Real(eps->tol)/ctx->N);
    392:   PetscInfo1(eps,"Estimation_#Eig %f\n",(double)ctx->est_eig);
    393:   *L_add = (PetscInt)PetscCeilReal((ctx->est_eig*eta)/ctx->M) - ctx->L;
    394:   if (*L_add < 0) *L_add = 0;
    395:   if (*L_add>ctx->L_max-ctx->L) {
    396:     PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
    397:     *L_add = ctx->L_max-ctx->L;
    398:   }
    399:   VecDestroy(&v);
    400:   VecDestroy(&vtemp);
    401:   return(0);
    402: }
    403: #endif

    407: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
    408: {
    410:   PetscMPIInt    sub_size;
    411:   PetscInt       i,j,k,s;
    412:   PetscScalar    *m,*temp,*temp2,*ppk,alp;
    413:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    414:   Mat            M;

    417:   MPI_Comm_size(PetscSubcommChild(ctx->subcomm),&sub_size);
    418:   PetscMalloc3(ctx->num_solve_point*ctx->L*(ctx->L+1),&temp,2*ctx->M*ctx->L*ctx->L,&temp2,ctx->num_solve_point,&ppk);
    419:   MatCreateSeqDense(PETSC_COMM_SELF,ctx->L,ctx->L_max*ctx->num_solve_point,NULL,&M);
    420:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
    421:   BVSetActiveColumns(ctx->Y,0,ctx->L_max*ctx->num_solve_point);
    422:   if (ctx->pA) {
    423:     BVSetActiveColumns(ctx->pV,0,ctx->L);
    424:     BVDot(ctx->Y,ctx->pV,M);
    425:   } else {
    426:     BVSetActiveColumns(ctx->V,0,ctx->L);
    427:     BVDot(ctx->Y,ctx->V,M);
    428:   }
    429:   MatDenseGetArray(M,&m);
    430:   for (i=0;i<ctx->num_solve_point;i++) {
    431:     for (j=0;j<ctx->L;j++) {
    432:       for (k=0;k<ctx->L;k++) {
    433:         temp[k+j*ctx->L+i*ctx->L*ctx->L]=m[k+j*ctx->L+i*ctx->L*ctx->L_max];
    434:       }
    435:     }
    436:   }
    437:   MatDenseRestoreArray(M,&m);
    438:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    439:   for (k=0;k<2*ctx->M;k++) {
    440:     for (j=0;j<ctx->L;j++) {
    441:       for (i=0;i<ctx->num_solve_point;i++) {
    442:         alp = ppk[i]*ctx->weight[i*ctx->subcomm->n + ctx->subcomm_id];
    443:         for (s=0;s<ctx->L;s++) {
    444:           if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
    445:           else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
    446:         }
    447:       }
    448:     }
    449:     for (i=0;i<ctx->num_solve_point;i++)
    450:       ppk[i] *= ctx->pp[i*ctx->subcomm->n + ctx->subcomm_id];
    451:   }
    452:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] /= sub_size;
    453:   MPI_Allreduce(temp2,Mu,2*ctx->M*ctx->L*ctx->L,MPIU_SCALAR,MPIU_SUM,(PetscObjectComm((PetscObject)eps)));
    454:   PetscFree3(temp,temp2,ppk);
    455:   MatDestroy(&M);
    456:   return(0);
    457: }

    461: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,PetscScalar *H)
    462: {
    463:   EPS_CISS *ctx = (EPS_CISS*)eps->data;
    464:   PetscInt i,j,k,L=ctx->L,M=ctx->M;

    467:   for (k=0;k<L*M;k++)
    468:     for (j=0;j<M;j++)
    469:       for (i=0;i<L;i++)
    470:         H[j*L+i+k*L*M] = Mu[i+k*L+(j+s)*L*L];
    471:   return(0);
    472: }

    476: static PetscErrorCode SVD_H0(EPS eps,PetscScalar *S,PetscInt *K)
    477: {
    478: #if defined(SLEPC_MISSING_LAPACK_GESVD)
    480:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
    481: #else
    483:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    484:   PetscInt       i,ml=ctx->L*ctx->M;
    485:   PetscBLASInt   m,n,lda,ldu,ldvt,lwork,info;
    486:   PetscScalar    *work;
    487: #if defined(PETSC_USE_COMPLEX)
    488:   PetscReal      *rwork;
    489: #endif

    492:   PetscMalloc1(5*ml,&work);
    493: #if defined(PETSC_USE_COMPLEX)
    494:   PetscMalloc1(5*ml,&rwork);
    495: #endif
    496:   PetscBLASIntCast(ml,&m);
    497:   n = m; lda = m; ldu = m; ldvt = m; lwork = 5*m;
    498:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);
    499: #if defined(PETSC_USE_COMPLEX)
    500:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    501: #else
    502:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","N",&m,&n,S,&lda,ctx->sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    503: #endif
    504:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);
    505:   PetscFPTrapPop();
    506:   (*K) = 0;
    507:   for (i=0;i<ml;i++) {
    508:     if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
    509:   }
    510:   PetscFree(work);
    511: #if defined(PETSC_USE_COMPLEX)
    512:   PetscFree(rwork);
    513: #endif
    514:   return(0);
    515: #endif
    516: }

    520: static PetscErrorCode ConstructS(EPS eps)
    521: {
    523:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    524:   PetscInt       i,j,k,vec_local_size,p_id;
    525:   Vec            v,sj,yj;
    526:   PetscScalar    *ppk, *v_data, m = 1;

    529:   BVGetSizes(ctx->Y,&vec_local_size,NULL,NULL);
    530:   PetscMalloc1(ctx->num_solve_point,&ppk);
    531:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    532:   BVGetColumn(ctx->Y,0,&yj);
    533:   VecDuplicate(yj,&v);
    534:   BVRestoreColumn(ctx->Y,0,&yj);
    535:   for (k=0;k<ctx->M;k++) {
    536:     for (j=0;j<ctx->L;j++) {
    537:       VecSet(v,0);
    538:       for (i=0;i<ctx->num_solve_point;i++) {
    539:         p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    540:         BVSetActiveColumns(ctx->Y,i*ctx->L_max+j,i*ctx->L_max+j+1);
    541:         BVMultVec(ctx->Y,ppk[i]*ctx->weight[p_id],1,v,&m);
    542:       }
    543:       if (ctx->useconj) {
    544:         VecGetArray(v,&v_data);
    545:         for (i=0;i<vec_local_size;i++) v_data[i] = PetscRealPart(v_data[i])*2;
    546:         VecRestoreArray(v,&v_data);
    547:       }
    548:       BVGetColumn(ctx->S,k*ctx->L+j,&sj);
    549:       if (ctx->pA) {
    550:         VecSet(sj,0);
    551:         VecScatterBegin(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
    552:         VecScatterEnd(ctx->scatterin,v,sj,ADD_VALUES,SCATTER_REVERSE);
    553:       } else {
    554:         VecCopy(v,sj);
    555:       }
    556:       BVRestoreColumn(ctx->S,k*ctx->L+j,&sj);
    557:     }
    558:     for (i=0;i<ctx->num_solve_point;i++) {
    559:       p_id = i*ctx->subcomm->n + ctx->subcomm_id;
    560:       ppk[i] *= ctx->pp[p_id];
    561:     }
    562:   }
    563:   PetscFree(ppk);
    564:   VecDestroy(&v);
    565:   return(0);
    566: }

    570: static PetscErrorCode SVD_S(BV S,PetscInt ml,PetscReal delta,PetscReal *sigma,PetscInt *K)
    571: {
    572: #if defined(SLEPC_MISSING_LAPACK_GESVD)
    574:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD - Lapack routine is unavailable");
    575: #else
    577:   PetscInt       i,j,k,local_size;
    578:   PetscScalar    *work,*temp,*B,*tempB,*s_data,*Q1,*Q2,*temp2,alpha=1,beta=0;
    579:   PetscBLASInt   l,m,n,lda,ldu,ldvt,lwork,info,ldb,ldc;
    580: #if defined(PETSC_USE_COMPLEX)
    581:   PetscReal      *rwork;
    582: #endif

    585:   BVGetSizes(S,&local_size,NULL,NULL);
    586:   BVGetArray(S,&s_data);
    587:   PetscMalloc7(ml*ml,&temp,ml*ml,&temp2,local_size*ml,&Q1,local_size*ml,&Q2,ml*ml,&B,ml*ml,&tempB,5*ml,&work);
    588:   PetscMemzero(B,ml*ml*sizeof(PetscScalar));
    589: #if defined(PETSC_USE_COMPLEX)
    590:   PetscMalloc1(5*ml,&rwork);
    591: #endif
    592:   PetscFPTrapPush(PETSC_FP_TRAP_OFF);

    594:   for (i=0;i<ml;i++) {
    595:     B[i*ml+i]=1;
    596:   }

    598:   for (k=0;k<2;k++) {
    599:     PetscBLASIntCast(local_size,&m);
    600:     PetscBLASIntCast(ml,&l);
    601:     n = l; lda = m; ldb = m; ldc = l;
    602:     if (k == 0) {
    603:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,s_data,&lda,s_data,&ldb,&beta,temp,&ldc));
    604:     } else if ((k%2)==1) {
    605:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q1,&lda,Q1,&ldb,&beta,temp,&ldc));
    606:     } else {
    607:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&l,&n,&m,&alpha,Q2,&lda,Q2,&ldb,&beta,temp,&ldc));
    608:     }
    609:     PetscMemzero(temp2,ml*ml*sizeof(PetscScalar));
    610:     MPI_Allreduce(temp,temp2,ml*ml,MPIU_SCALAR,MPIU_SUM,(PetscObjectComm((PetscObject)S)));

    612:     PetscBLASIntCast(ml,&m);
    613:     n = m; lda = m; lwork = 5*m, ldu = 1; ldvt = 1;
    614: #if defined(PETSC_USE_COMPLEX)
    615:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    616: #else
    617:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&m,&n,temp2,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    618: #endif
    619:     if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);

    621:     PetscBLASIntCast(local_size,&l);
    622:     PetscBLASIntCast(ml,&n);
    623:     m = n; lda = l; ldb = m; ldc = l;
    624:     if (k==0) {
    625:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,s_data,&lda,temp2,&ldb,&beta,Q1,&ldc));
    626:     } else if ((k%2)==1) {
    627:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q1,&lda,temp2,&ldb,&beta,Q2,&ldc));
    628:     } else {
    629:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,Q2,&lda,temp2,&ldb,&beta,Q1,&ldc));
    630:     }

    632:     PetscBLASIntCast(ml,&l);
    633:     m = l; n = l; lda = l; ldb = m; ldc = l;
    634:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&l,&n,&m,&alpha,B,&lda,temp2,&ldb,&beta,tempB,&ldc));
    635:     for (i=0;i<ml;i++) {
    636:       sigma[i] = sqrt(sigma[i]);
    637:       for (j=0;j<local_size;j++) {
    638:         if ((k%2)==1) Q2[j+i*local_size]/=sigma[i];
    639:         else Q1[j+i*local_size]/=sigma[i];
    640:       }
    641:       for (j=0;j<ml;j++) {
    642:         B[j+i*ml]=tempB[j+i*ml]*sigma[i];
    643:       }
    644:     }
    645:   }

    647:   PetscBLASIntCast(ml,&m);
    648:   n = m; lda = m; ldu=1; ldvt=1;
    649: #if defined(PETSC_USE_COMPLEX)
    650:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,rwork,&info));
    651: #else
    652:   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("N","O",&m,&n,B,&lda,sigma,NULL,&ldu,NULL,&ldvt,work,&lwork,&info));
    653: #endif
    654:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGESVD %d",info);

    656:   PetscBLASIntCast(local_size,&l);
    657:   PetscBLASIntCast(ml,&n);
    658:   m = n; lda = l; ldb = m; ldc = l;
    659:   if ((k%2)==1) {
    660:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q1,&lda,B,&ldb,&beta,s_data,&ldc));
    661:   } else {
    662:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","T",&l,&n,&m,&alpha,Q2,&lda,B,&ldb,&beta,s_data,&ldc));
    663:   }
    664:
    665:   PetscFPTrapPop();
    666:   BVRestoreArray(S,&s_data);

    668:   (*K) = 0;
    669:   for (i=0;i<ml;i++) {
    670:     if (sigma[i]/PetscMax(sigma[0],1)>delta) (*K)++;
    671:   }
    672:   PetscFree7(temp,temp2,Q1,Q2,B,tempB,work);
    673: #if defined(PETSC_USE_COMPLEX)
    674:   PetscFree(rwork);
    675: #endif
    676:   return(0);
    677: #endif
    678: }

    682: static PetscErrorCode isGhost(EPS eps,PetscInt ld,PetscInt nv,PetscBool *fl)
    683: {
    685:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    686:   PetscInt       i,j;
    687:   PetscScalar    *pX;
    688:   PetscReal      *tau,s1,s2,tau_max=0.0;

    691:   PetscMalloc1(nv,&tau);
    692:   DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    693:   DSGetArray(eps->ds,DS_MAT_X,&pX);

    695:   for (i=0;i<nv;i++) {
    696:     s1 = 0;
    697:     s2 = 0;
    698:     for (j=0;j<nv;j++) {
    699:       s1 += PetscAbsScalar(PetscPowScalarInt(pX[i*ld+j],2));
    700:       s2 += PetscPowRealInt(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
    701:     }
    702:     tau[i] = s1/s2;
    703:     tau_max = PetscMax(tau_max,tau[i]);
    704:   }
    705:   DSRestoreArray(eps->ds,DS_MAT_X,&pX);
    706:   for (i=0;i<nv;i++) {
    707:     tau[i] /= tau_max;
    708:   }
    709:   for (i=0;i<nv;i++) {
    710:     if (tau[i]>=ctx->spurious_threshold) fl[i] = PETSC_TRUE;
    711:     else fl[i] = PETSC_FALSE;
    712:   }
    713:   PetscFree(tau);
    714:   return(0);
    715: }

    719: PetscErrorCode EPSSetUp_CISS(EPS eps)
    720: {
    722:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    723:   const char     *prefix;
    724:   PetscInt       i;
    725:   PetscBool      issinvert,istrivial,isring,isellipse,flg;
    726:   PetscScalar    center;
    727:   Mat            A;

    730:   eps->ncv = PetscMin(eps->n,ctx->L_max*ctx->M);
    731:   if (!eps->mpd) eps->mpd = eps->ncv;
    732:   if (!eps->which) eps->which = EPS_ALL;
    733:   if (!eps->extraction) { EPSSetExtraction(eps,EPS_RITZ); }
    734:   else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
    735:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");

    737:   /* check region */
    738:   RGIsTrivial(eps->rg,&istrivial);
    739:   if (istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"EPSCISS requires a nontrivial region, e.g. -rg_type ellipse ...");
    740:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    741:   PetscObjectTypeCompare((PetscObject)eps->rg,RGRING,&isring);
    742:   if (!isellipse && !isring) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for elliptic or ring regions");
    743:   if (isring) {
    744: #if !defined(PETSC_USE_COMPLEX)
    745:     SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Currently only implemented for elliptic regions");
    746: #endif
    747:     ctx->useconj = PETSC_FALSE;
    748:   } else {
    749:     RGEllipseGetParameters(eps->rg,&center,NULL,NULL);
    750: #if defined(PETSC_USE_COMPLEX)
    751:     if (ctx->isreal && PetscImaginaryPart(center) == 0.0) ctx->useconj = PETSC_TRUE;
    752:     else ctx->useconj = PETSC_FALSE;
    753: #else
    754:     ctx->useconj = PETSC_FALSE;
    755: #endif
    756:   }
    757:   /* create split comm */
    758:   SetSolverComm(eps);

    760:   EPSAllocateSolution(eps,0);
    761:   PetscMalloc4(ctx->N,&ctx->weight,ctx->N,&ctx->omega,ctx->N,&ctx->pp,ctx->L_max*ctx->M,&ctx->sigma);
    762:   PetscLogObjectMemory((PetscObject)eps,3*ctx->N*sizeof(PetscScalar)+ctx->L_max*ctx->N*sizeof(PetscReal));

    764:   /* allocate basis vectors */
    765:   BVDuplicateResize(eps->V,ctx->L_max*ctx->M,&ctx->S);
    766:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->S);
    767:   BVDuplicateResize(eps->V,ctx->L_max,&ctx->V);
    768:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->V);

    770:   STGetOperators(eps->st,0,&A);
    771:   PetscObjectTypeCompare((PetscObject)A,MATSHELL,&flg);
    772:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Matrix type shell not supported in this solver");

    774:   CISSRedundantMat(eps);
    775:   if (ctx->pA) {
    776:     CISSScatterVec(eps);
    777:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->pV);
    778:     BVSetSizesFromVec(ctx->pV,ctx->xsub,eps->n);
    779:     BVSetFromOptions(ctx->pV);
    780:     BVResize(ctx->pV,ctx->L_max,PETSC_FALSE);
    781:     PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->pV);
    782:   }

    784:   if (ctx->usest) {
    785:     PetscObjectTypeCompare((PetscObject)eps->st,STSINVERT,&issinvert);
    786:     if (!issinvert) { STSetType(eps->st,STSINVERT); }
    787:   } else {
    788:     PetscMalloc2(ctx->num_solve_point,&ctx->ksp,ctx->num_solve_point,&ctx->kspMat);
    789:     PetscLogObjectMemory((PetscObject)eps,ctx->num_solve_point*sizeof(KSP)+ctx->num_solve_point*sizeof(Mat));
    790:     for (i=0;i<ctx->num_solve_point;i++) {
    791:       KSPCreate(PetscSubcommChild(ctx->subcomm),&ctx->ksp[i]);
    792:       PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
    793:       PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->ksp[i]);
    794:       KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
    795:       EPSGetOptionsPrefix(eps,&prefix);
    796:       KSPAppendOptionsPrefix(ctx->ksp[i],prefix);
    797:       KSPSetErrorIfNotConverged(ctx->ksp[i],PETSC_TRUE);
    798:     }
    799:   }

    801:   if (ctx->pA) {
    802:     BVCreate(PetscObjectComm((PetscObject)ctx->xsub),&ctx->Y);
    803:     BVSetSizesFromVec(ctx->Y,ctx->xsub,eps->n);
    804:     BVSetFromOptions(ctx->Y);
    805:     BVResize(ctx->Y,ctx->num_solve_point*ctx->L_max,PETSC_FALSE);
    806:   } else {
    807:     BVDuplicateResize(eps->V,ctx->num_solve_point*ctx->L_max,&ctx->Y);
    808:   }
    809:   PetscLogObjectParent((PetscObject)eps,(PetscObject)ctx->Y);

    811:   if (eps->ishermitian && eps->ispositive) {
    812:     DSSetType(eps->ds,DSGHEP);
    813:   } else {
    814:     DSSetType(eps->ds,DSGNHEP);
    815:   }
    816:   DSAllocate(eps->ds,eps->ncv);
    817:   EPSSetWorkVecs(eps,2);

    819: #if !defined(PETSC_USE_COMPLEX)
    820:   if (!eps->ishermitian) { PetscInfo(eps,"Warning: complex eigenvalues are not calculated exactly without --with-scalar-type=complex in PETSc\n"); }
    821: #endif

    823:   /* dispatch solve method */
    824:   eps->ops->solve = EPSSolve_CISS;
    825:   return(0);
    826: }

    830: PetscErrorCode EPSSolve_CISS(EPS eps)
    831: {
    833:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    834:   Mat            A,B,X,M,pA,pB;
    835:   PetscInt       i,ld,nmat,L_add=0,nv=0,L_base=ctx->L,inner,outer,nlocal,*inside;
    836:   PetscScalar    *Mu,*H0,*rr,*temp;
    837:   PetscReal      error,max_error;
    838:   PetscBool      *fl1;
    839:   Vec            si,w[3];
    840:   SlepcSC        sc;
    841: #if defined(PETSC_USE_COMPLEX)
    842:   PetscBool      isellipse;
    843: #endif

    846:   w[0] = eps->work[0];
    847:   w[1] = NULL;
    848:   w[2] = eps->work[1];
    849:   /* override SC settings */
    850:   DSGetSlepcSC(eps->ds,&sc);
    851:   sc->comparison    = SlepcCompareLargestMagnitude;
    852:   sc->comparisonctx = NULL;
    853:   sc->map           = NULL;
    854:   sc->mapobj        = NULL;
    855:   VecGetLocalSize(w[0],&nlocal);
    856:   DSGetLeadingDimension(eps->ds,&ld);
    857:   STGetNumMatrices(eps->st,&nmat);
    858:   STGetOperators(eps->st,0,&A);
    859:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
    860:   else B = NULL;
    861:   SetPathParameter(eps);
    862:   CISSVecSetRandom(ctx->V,0,ctx->L,eps->rand);

    864:   if (ctx->pA) {
    865:     VecScatterVecs(eps,ctx->V,ctx->L);
    866:     SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_TRUE);
    867:   } else {
    868:     SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_TRUE);
    869:   }
    870: #if defined(PETSC_USE_COMPLEX)
    871:   PetscObjectTypeCompare((PetscObject)eps->rg,RGELLIPSE,&isellipse);
    872:   if (isellipse) {
    873:     EstimateNumberEigs(eps,&L_add);
    874:   } else {
    875:     L_add = 0;
    876:   }
    877: #else
    878:   L_add = 0;
    879: #endif
    880:   if (L_add>0) {
    881:     PetscInfo2(eps,"Changing L %D -> %D by Estimate #Eig\n",ctx->L,ctx->L+L_add);
    882:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,eps->rand);
    883:     if (ctx->pA) {
    884:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
    885:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
    886:     } else {
    887:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
    888:     }
    889:     ctx->L += L_add;
    890:   }
    891:   PetscMalloc2(ctx->L*ctx->L*ctx->M*2,&Mu,ctx->L*ctx->M*ctx->L*ctx->M,&H0);
    892:   for (i=0;i<ctx->refine_blocksize;i++) {
    893:     CalcMu(eps,Mu);
    894:     BlockHankel(eps,Mu,0,H0);
    895:     SVD_H0(eps,H0,&nv);
    896:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M || ctx->L == ctx->L_max) break;
    897:     L_add = L_base;
    898:     if (ctx->L+L_add>ctx->L_max) L_add = ctx->L_max-ctx->L;
    899:     PetscInfo2(eps,"Changing L %D -> %D by SVD(H0)\n",ctx->L,ctx->L+L_add);
    900:     CISSVecSetRandom(ctx->V,ctx->L,ctx->L+L_add,eps->rand);
    901:     if (ctx->pA) {
    902:       VecScatterVecs(eps,ctx->V,ctx->L+L_add);
    903:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,ctx->L,ctx->L+L_add,PETSC_FALSE);
    904:     } else {
    905:       SolveLinearSystem(eps,A,B,ctx->V,ctx->L,ctx->L+L_add,PETSC_FALSE);
    906:     }
    907:     ctx->L += L_add;
    908:   }
    909:   PetscFree2(Mu,H0);

    911:   for (outer=0;outer<=ctx->refine_outer;outer++) {
    912:     for (inner=0;inner<=ctx->refine_inner;inner++) {
    913:       ConstructS(eps);
    914:       BVSetActiveColumns(ctx->S,0,ctx->L);
    915:       BVCopy(ctx->S,ctx->V);
    916:       SVD_S(ctx->S,ctx->L*ctx->M,ctx->delta,ctx->sigma,&nv);
    917:       if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
    918:         if (ctx->pA) {
    919:           VecScatterVecs(eps,ctx->V,ctx->L);
    920:           SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
    921:         } else {
    922:           SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
    923:         }
    924:       } else break;
    925:     }

    927:     eps->nconv = 0;
    928:     if (nv == 0) break;
    929:     DSSetDimensions(eps->ds,nv,0,0,0);
    930:     DSSetState(eps->ds,DS_STATE_RAW);

    932:     BVSetActiveColumns(ctx->S,0,nv);
    933:     DSGetMat(eps->ds,DS_MAT_A,&pA);
    934:     MatZeroEntries(pA);
    935:     BVMatProject(ctx->S,A,ctx->S,pA);
    936:     DSRestoreMat(eps->ds,DS_MAT_A,&pA);
    937:     DSGetMat(eps->ds,DS_MAT_B,&pB);
    938:     MatZeroEntries(pB);
    939:     if (B) { BVMatProject(ctx->S,B,ctx->S,pB); }
    940:     else { MatShift(pB,1); }
    941:     DSRestoreMat(eps->ds,DS_MAT_B,&pB);

    943:     DSSolve(eps->ds,eps->eigr,eps->eigi);
    944:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);

    946:     PetscMalloc3(nv,&fl1,nv,&inside,nv,&rr);
    947:     isGhost(eps,ld,nv,fl1);
    948:     RGCheckInside(eps->rg,nv,eps->eigr,eps->eigi,inside);
    949:     for (i=0;i<nv;i++) {
    950:       if (fl1[i] && inside[i]>0) {
    951:         rr[i] = 1.0;
    952:         eps->nconv++;
    953:       } else rr[i] = 0.0;
    954:     }
    955:     DSSort(eps->ds,eps->eigr,eps->eigi,rr,NULL,&eps->nconv);
    956:     PetscFree3(fl1,inside,rr);
    957:     BVSetActiveColumns(eps->V,0,nv);
    958:     BVSetActiveColumns(ctx->S,0,nv);
    959:     BVCopy(ctx->S,eps->V);

    961:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    962:     DSGetMat(eps->ds,DS_MAT_X,&X);
    963:     BVMultInPlace(ctx->S,X,0,eps->nconv);
    964:     if (eps->ishermitian) {
    965:       BVMultInPlace(eps->V,X,0,eps->nconv);
    966:     }
    967:     MatDestroy(&X);
    968:     max_error = 0.0;
    969:     for (i=0;i<eps->nconv;i++) {
    970:       BVGetColumn(ctx->S,i,&si);
    971:       VecNormalize(si,NULL);
    972:       EPSComputeResidualNorm_Private(eps,eps->eigr[i],0,si,NULL,w,&error);
    973:       (*eps->converged)(eps,eps->eigr[i],0,error,&error,eps->convergedctx);
    974:       BVRestoreColumn(ctx->S,i,&si);
    975:       max_error = PetscMax(max_error,error);
    976:     }

    978:     if (max_error <= eps->tol || outer == ctx->refine_outer) break;

    980:     if (eps->nconv > ctx->L) nv = eps->nconv;
    981:     else if (ctx->L > nv) nv = ctx->L;
    982:     MatCreateSeqDense(PETSC_COMM_SELF,nv,ctx->L,NULL,&M);
    983:     MatDenseGetArray(M,&temp);
    984:     for (i=0;i<ctx->L*nv;i++) {
    985:       PetscRandomGetValue(eps->rand,&temp[i]);
    986:       temp[i] = PetscRealPart(temp[i]);
    987:     }
    988:     MatDenseRestoreArray(M,&temp);
    989:     BVSetActiveColumns(ctx->S,0,nv);
    990:     BVMultInPlace(ctx->S,M,0,ctx->L);
    991:     MatDestroy(&M);
    992:     BVSetActiveColumns(ctx->S,0,ctx->L);
    993:     BVCopy(ctx->S,ctx->V);
    994:     if (ctx->pA) {
    995:       VecScatterVecs(eps,ctx->V,ctx->L);
    996:       SolveLinearSystem(eps,ctx->pA,ctx->pB,ctx->pV,0,ctx->L,PETSC_FALSE);
    997:     } else {
    998:       SolveLinearSystem(eps,A,B,ctx->V,0,ctx->L,PETSC_FALSE);
    999:     }
    1000:   }
    1001:   eps->reason = EPS_CONVERGED_TOL;
    1002:   return(0);
    1003: }

    1007: static PetscErrorCode EPSCISSSetSizes_CISS(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
    1008: {
    1010:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    1013:   if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
    1014:     if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
    1015:   } else {
    1016:     if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
    1017:     if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
    1018:     if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
    1019:   }
    1020:   if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
    1021:     ctx->L = 16;
    1022:   } else {
    1023:     if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
    1024:     if (bs>ctx->L_max) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be less than or equal to the maximum number of block size");
    1025:     ctx->L = bs;
    1026:   }
    1027:   if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
    1028:     ctx->M = ctx->N/4;
    1029:   } else {
    1030:     if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
    1031:     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");
    1032:     ctx->M = ms;
    1033:   }
    1034:   if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
    1035:     ctx->num_subcomm = 1;
    1036:   } else {
    1037:     if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
    1038:     ctx->num_subcomm = npart;
    1039:   }
    1040:   if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
    1041:     ctx->L = 256;
    1042:   } else {
    1043:     if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
    1044:     if (bsmax<ctx->L) ctx->L_max = ctx->L;
    1045:     else ctx->L_max = bsmax;
    1046:   }
    1047:   ctx->isreal = isreal;
    1048:   EPSReset(eps);   /* clean allocated arrays and force new setup */
    1049:   return(0);
    1050: }

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

    1057:    Logically Collective on EPS

    1059:    Input Parameters:
    1060: +  eps   - the eigenproblem solver context
    1061: .  ip    - number of integration points
    1062: .  bs    - block size
    1063: .  ms    - moment size
    1064: .  npart - number of partitions when splitting the communicator
    1065: .  bsmax - max block size
    1066: -  isreal - A and B are real

    1068:    Options Database Keys:
    1069: +  -eps_ciss_integration_points - Sets the number of integration points
    1070: .  -eps_ciss_blocksize - Sets the block size
    1071: .  -eps_ciss_moments - Sets the moment size
    1072: .  -eps_ciss_partitions - Sets the number of partitions
    1073: .  -eps_ciss_maxblocksize - Sets the maximum block size
    1074: -  -eps_ciss_realmats - A and B are real

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

    1081:    Level: advanced

    1083: .seealso: EPSCISSGetSizes()
    1084: @*/
    1085: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
    1086: {

    1097:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,isreal));
    1098:   return(0);
    1099: }

    1103: static PetscErrorCode EPSCISSGetSizes_CISS(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
    1104: {
    1105:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1108:   if (ip) *ip = ctx->N;
    1109:   if (bs) *bs = ctx->L;
    1110:   if (ms) *ms = ctx->M;
    1111:   if (npart) *npart = ctx->num_subcomm;
    1112:   if (bsmax) *bsmax = ctx->L_max;
    1113:   if (isreal) *isreal = ctx->isreal;
    1114:   return(0);
    1115: }

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

    1122:    Not Collective

    1124:    Input Parameter:
    1125: .  eps - the eigenproblem solver context

    1127:    Output Parameters:
    1128: +  ip    - number of integration points
    1129: .  bs    - block size
    1130: .  ms    - moment size
    1131: .  npart - number of partitions when splitting the communicator
    1132: .  bsmax - max block size
    1133: -  isreal - A and B are real

    1135:    Level: advanced

    1137: .seealso: EPSCISSSetSizes()
    1138: @*/
    1139: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
    1140: {

    1145:   PetscTryMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,isreal));
    1146:   return(0);
    1147: }

    1151: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
    1152: {
    1153:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1156:   if (delta == PETSC_DEFAULT) {
    1157:     ctx->delta = 1e-12;
    1158:   } else {
    1159:     if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
    1160:     ctx->delta = delta;
    1161:   }
    1162:   if (spur == PETSC_DEFAULT) {
    1163:     ctx->spurious_threshold = 1e-4;
    1164:   } else {
    1165:     if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
    1166:     ctx->spurious_threshold = spur;
    1167:   }
    1168:   return(0);
    1169: }

    1173: /*@
    1174:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
    1175:    the CISS solver.

    1177:    Logically Collective on EPS

    1179:    Input Parameters:
    1180: +  eps   - the eigenproblem solver context
    1181: .  delta - threshold for numerical rank
    1182: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1184:    Options Database Keys:
    1185: +  -eps_ciss_delta - Sets the delta
    1186: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

    1188:    Level: advanced

    1190: .seealso: EPSCISSGetThreshold()
    1191: @*/
    1192: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
    1193: {

    1200:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
    1201:   return(0);
    1202: }

    1206: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
    1207: {
    1208:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1211:   if (delta) *delta = ctx->delta;
    1212:   if (spur)  *spur = ctx->spurious_threshold;
    1213:   return(0);
    1214: }

    1218: /*@
    1219:    EPSCISSGetThreshold - Gets the values of various threshold parameters
    1220:    in the CISS solver.

    1222:    Not Collective

    1224:    Input Parameter:
    1225: .  eps - the eigenproblem solver context

    1227:    Output Parameters:
    1228: +  delta - threshold for numerical rank
    1229: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1231:    Level: advanced

    1233: .seealso: EPSCISSSetThreshold()
    1234: @*/
    1235: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
    1236: {

    1241:   PetscTryMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
    1242:   return(0);
    1243: }

    1247: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
    1248: {
    1249:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1252:   if (inner == PETSC_DEFAULT) {
    1253:     ctx->refine_inner = 0;
    1254:   } else {
    1255:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
    1256:     ctx->refine_inner = inner;
    1257:   }
    1258:   if (outer == PETSC_DEFAULT) {
    1259:     ctx->refine_outer = 0;
    1260:   } else {
    1261:     if (outer<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine outer argument must be >= 0");
    1262:     ctx->refine_outer = outer;
    1263:   }
    1264:   if (blsize == PETSC_DEFAULT) {
    1265:     ctx->refine_blocksize = 0;
    1266:   } else {
    1267:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
    1268:     ctx->refine_blocksize = blsize;
    1269:   }
    1270:   return(0);
    1271: }

    1275: /*@
    1276:    EPSCISSSetRefinement - Sets the values of various refinement parameters
    1277:    in the CISS solver.

    1279:    Logically Collective on EPS

    1281:    Input Parameters:
    1282: +  eps    - the eigenproblem solver context
    1283: .  inner  - number of iterative refinement iterations (inner loop)
    1284: .  outer  - number of iterative refinement iterations (outer loop)
    1285: -  blsize - number of iterative refinement iterations (blocksize loop)

    1287:    Options Database Keys:
    1288: +  -eps_ciss_refine_inner - Sets number of inner iterations
    1289: .  -eps_ciss_refine_outer - Sets number of outer iterations
    1290: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

    1292:    Level: advanced

    1294: .seealso: EPSCISSGetRefinement()
    1295: @*/
    1296: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
    1297: {

    1305:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt,PetscInt),(eps,inner,outer,blsize));
    1306:   return(0);
    1307: }

    1311: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *outer,PetscInt *blsize)
    1312: {
    1313:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1316:   if (inner)  *inner = ctx->refine_inner;
    1317:   if (outer)  *outer = ctx->refine_outer;
    1318:   if (blsize) *blsize = ctx->refine_blocksize;
    1319:   return(0);
    1320: }

    1324: /*@
    1325:    EPSCISSGetRefinement - Gets the values of various refinement parameters
    1326:    in the CISS solver.

    1328:    Not Collective

    1330:    Input Parameter:
    1331: .  eps - the eigenproblem solver context

    1333:    Output Parameters:
    1334: +  inner  - number of iterative refinement iterations (inner loop)
    1335: .  outer  - number of iterative refinement iterations (outer loop)
    1336: -  blsize - number of iterative refinement iterations (blocksize loop)

    1338:    Level: advanced

    1340: .seealso: EPSCISSSetRefinement()
    1341: @*/
    1342: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *outer,PetscInt *blsize)
    1343: {

    1348:   PetscTryMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*,PetscInt*),(eps,inner,outer,blsize));
    1349:   return(0);
    1350: }

    1354: static PetscErrorCode EPSCISSSetUseST_CISS(EPS eps,PetscBool usest)
    1355: {
    1356:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1359:   ctx->usest = usest;
    1360:   return(0);
    1361: }

    1365: /*@
    1366:    EPSCISSSetUseST - Sets a flag indicating that the CISS solver will
    1367:    use the ST object for the linear solves.

    1369:    Logically Collective on EPS

    1371:    Input Parameters:
    1372: +  eps    - the eigenproblem solver context
    1373: -  usest  - boolean flag to use the ST object or not

    1375:    Options Database Keys:
    1376: +  -eps_ciss_usest <bool> - whether the ST object will be used or not

    1378:    Level: advanced

    1380: .seealso: EPSCISSGetUseST()
    1381: @*/
    1382: PetscErrorCode EPSCISSSetUseST(EPS eps,PetscBool usest)
    1383: {

    1389:   PetscTryMethod(eps,"EPSCISSSetUseST_C",(EPS,PetscBool),(eps,usest));
    1390:   return(0);
    1391: }

    1395: static PetscErrorCode EPSCISSGetUseST_CISS(EPS eps,PetscBool *usest)
    1396: {
    1397:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1400:   *usest = ctx->usest;
    1401:   return(0);
    1402: }

    1406: /*@
    1407:    EPSCISSGetUseST - Gets the flag for using the ST object
    1408:    in the CISS solver.

    1410:    Not Collective

    1412:    Input Parameter:
    1413: .  eps - the eigenproblem solver context

    1415:    Output Parameters:
    1416: +  usest - boolean flag indicating if the ST object is being used

    1418:    Level: advanced

    1420: .seealso: EPSCISSSetUseST()
    1421: @*/
    1422: PetscErrorCode EPSCISSGetUseST(EPS eps, PetscBool *usest)
    1423: {

    1428:   PetscTryMethod(eps,"EPSCISSGetUseST_C",(EPS,PetscBool*),(eps,usest));
    1429:   return(0);
    1430: }

    1434: PetscErrorCode EPSReset_CISS(EPS eps)
    1435: {
    1437:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1438:   PetscInt       i;

    1441:   PetscSubcommDestroy(&ctx->subcomm);
    1442:   PetscFree4(ctx->weight,ctx->omega,ctx->pp,ctx->sigma);
    1443:   BVDestroy(&ctx->S);
    1444:   BVDestroy(&ctx->V);
    1445:   BVDestroy(&ctx->Y);
    1446:   if (!ctx->usest) {
    1447:     for (i=0;i<ctx->num_solve_point;i++) {
    1448:       KSPDestroy(&ctx->ksp[i]);
    1449:     }
    1450:     for (i=0;i<ctx->num_solve_point;i++) {
    1451:       MatDestroy(&ctx->kspMat[i]);
    1452:     }
    1453:     PetscFree2(ctx->ksp,ctx->kspMat);
    1454:   }
    1455:   VecScatterDestroy(&ctx->scatterin);
    1456:   VecDestroy(&ctx->xsub);
    1457:   VecDestroy(&ctx->xdup);
    1458:   if (ctx->pA) {
    1459:     MatDestroy(&ctx->pA);
    1460:     MatDestroy(&ctx->pB);
    1461:     BVDestroy(&ctx->pV);
    1462:   }
    1463:   return(0);
    1464: }

    1468: PetscErrorCode EPSSetFromOptions_CISS(PetscOptions *PetscOptionsObject,EPS eps)
    1469: {
    1471:   PetscReal      r3,r4;
    1472:   PetscInt       i1,i2,i3,i4,i5,i6,i7,i8;
    1473:   PetscBool      b1,b2;

    1476:   PetscOptionsHead(PetscOptionsObject,"EPS CISS Options");
    1477:   EPSCISSGetSizes(eps,&i1,&i2,&i3,&i4,&i5,&b1);
    1478:   PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
    1479:   PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
    1480:   PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
    1481:   PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
    1482:   PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
    1483:   PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
    1484:   EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

    1486:   EPSCISSGetThreshold(eps,&r3,&r4);
    1487:   PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
    1488:   PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
    1489:   EPSCISSSetThreshold(eps,r3,r4);

    1491:   EPSCISSGetRefinement(eps,&i6,&i7,&i8);
    1492:   PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
    1493:   PetscOptionsInt("-eps_ciss_refine_outer","CISS number of outer iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
    1494:   PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i8,&i8,NULL);
    1495:   EPSCISSSetRefinement(eps,i6,i7,i8);

    1497:   EPSCISSGetUseST(eps,&b2);
    1498:   PetscOptionsBool("-eps_ciss_usest","CISS use ST for linear solves","EPSCISSSetUseST",b2,&b2,NULL);
    1499:   EPSCISSSetUseST(eps,b2);

    1501:   PetscOptionsTail();
    1502:   return(0);
    1503: }

    1507: PetscErrorCode EPSDestroy_CISS(EPS eps)
    1508: {

    1512:   PetscFree(eps->data);
    1513:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
    1514:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
    1515:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
    1516:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
    1517:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
    1518:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
    1519:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",NULL);
    1520:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",NULL);
    1521:   return(0);
    1522: }

    1526: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
    1527: {
    1529:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1530:   PetscBool      isascii;

    1533:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    1534:   if (isascii) {
    1535:     PetscViewerASCIIPrintf(viewer,"  CISS: sizes { integration points: %D, block size: %D, moment size: %D, partitions: %D, maximum block size: %D }\n",ctx->N,ctx->L,ctx->M,ctx->num_subcomm,ctx->L_max);
    1536:     if (ctx->isreal) {
    1537:       PetscViewerASCIIPrintf(viewer,"  CISS: exploiting symmetry of integration points\n");
    1538:     }
    1539:     PetscViewerASCIIPrintf(viewer,"  CISS: threshold { delta: %g, spurious threshold: %g }\n",(double)ctx->delta,(double)ctx->spurious_threshold);
    1540:     PetscViewerASCIIPrintf(viewer,"  CISS: iterative refinement  { inner: %D, outer: %D, blocksize: %D }\n",ctx->refine_inner,ctx->refine_outer, ctx->refine_blocksize);
    1541:     if (ctx->usest) {
    1542:       PetscViewerASCIIPrintf(viewer,"  CISS: using ST for linear solves\n");
    1543:     }
    1544:     PetscViewerASCIIPushTab(viewer);
    1545:     /*KSPView(ctx->ksp[0],viewer);*/
    1546:     PetscViewerASCIIPopTab(viewer);
    1547:   }
    1548:   return(0);
    1549: }

    1553: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
    1554: {
    1556:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    1559:   PetscNewLog(eps,&ctx);
    1560:   eps->data = ctx;
    1561:   eps->ops->setup          = EPSSetUp_CISS;
    1562:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
    1563:   eps->ops->destroy        = EPSDestroy_CISS;
    1564:   eps->ops->reset          = EPSReset_CISS;
    1565:   eps->ops->view           = EPSView_CISS;
    1566:   eps->ops->backtransform  = NULL;
    1567:   eps->ops->computevectors = EPSComputeVectors_Schur;
    1568:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
    1569:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
    1570:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
    1571:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
    1572:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
    1573:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
    1574:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetUseST_C",EPSCISSSetUseST_CISS);
    1575:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetUseST_C",EPSCISSGetUseST_CISS);
    1576:   /* set default values of parameters */
    1577:   ctx->N       = 32;
    1578:   ctx->L       = 16;
    1579:   ctx->M       = ctx->N/4;
    1580:   ctx->delta   = 1e-12;
    1581:   ctx->L_max   = 64;
    1582:   ctx->spurious_threshold = 1e-4;
    1583:   ctx->usest   = PETSC_FALSE;
    1584:   ctx->isreal  = PETSC_FALSE;
    1585:   ctx->refine_outer = 1;
    1586:   ctx->refine_inner = 1;
    1587:   ctx->refine_blocksize = 1;
    1588:   ctx->num_subcomm = 1;
    1589:   return(0);
    1590: }