Date: 2013-09-02T10:04:48+00:00

Actual source code: ciss.c

      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 Tetsuya 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:    Last update: Jun 2013

     26:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     27:    SLEPc - Scalable Library for Eigenvalue Problem Computations
     28:    Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain

     30:    This file is part of SLEPc.

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

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

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

     46: #include <slepc-private/epsimpl.h>                /*I "slepceps.h" I*/
     47: #include <slepcblaslapack.h>

     49: PetscErrorCode EPSSolve_CISS(EPS);

     51: typedef struct {
     52:   /* parameters */
     53:   PetscScalar center;     /* center of the region where to find eigenpairs (default: 0.0) */
     54:   PetscReal   radius;     /* radius of the region (1.0) */
     55:   PetscReal   vscale;     /* vertical scale of the region (1.0; 0.1 if spectrum real) */
     56:   PetscInt    N;          /* number of integration points (32) */
     57:   PetscInt    L;          /* block size (16) */
     58:   PetscInt    M;          /* moment degree (N/4 = 4) */
     59:   PetscReal   delta;      /* threshold of singular value (1e-12) */
     60:   PetscInt    npart;      /* number of partitions of the matrix (1) */
     61:   PetscReal   *sigma;     /* threshold for numerical rank */
     62:   PetscInt    L_max;      /* maximum number of columns of the source matrix V */
     63:   PetscReal   spurious_threshold; /* discard spurious eigenpairs */
     64:   PetscBool   isreal;     /* A and B are real */
     65:   PetscInt    refine_inner;
     66:   PetscInt    refine_outer;
     67:   PetscInt    refine_blocksize;
     68:   /* private data */
     69:   PetscInt    solver_comm_id;
     70:   PetscInt    num_solve_point;
     71:   PetscScalar *weight;
     72:   PetscScalar *omega;
     73:   PetscScalar *pp;
     74:   Vec         *V;
     75:   Vec         *Y;
     76:   Vec         *S;
     77:   KSP         *ksp;
     78:   PetscBool   useconj;
     79:   PetscReal   est_eig;
     80: } EPS_CISS;

     84: static PetscErrorCode SetSolverComm(EPS eps)
     85: {
     86:   EPS_CISS *ctx = (EPS_CISS*)eps->data;
     87:   PetscInt N = ctx->N;

     90:   if (ctx->useconj) N = N/2;
     91:   ctx->solver_comm_id = 0;
     92:   ctx->num_solve_point = N;
     93:   return(0);
     94: }

     98: static PetscErrorCode SetPathParameter(EPS eps)
     99: {
    100:   EPS_CISS  *ctx = (EPS_CISS*)eps->data;
    101:   PetscInt  i;
    102:   PetscReal theta;

    105:   for (i=0;i<ctx->N;i++){
    106:     theta = ((2*PETSC_PI)/ctx->N)*(i+0.5);
    107:     ctx->pp[i] = cos(theta) + PETSC_i*ctx->vscale*sin(theta);
    108:     ctx->omega[i] = ctx->center + ctx->radius*ctx->pp[i];
    109:     ctx->weight[i] = ctx->vscale*cos(theta) + PETSC_i*sin(theta);
    110:   }
    111:   return(0);
    112: }

    116: static PetscErrorCode CISSVecSetRandom(Vec x,PetscRandom rctx)
    117: {
    119:   PetscInt       j,nlocal;
    120:   PetscScalar    *vdata;

    123:   SlepcVecSetRandom(x,rctx);
    124:   VecGetLocalSize(x,&nlocal);
    125:   VecGetArray(x,&vdata);
    126:   for (j=0;j<nlocal;j++) {
    127:     vdata[j] = PetscRealPart(vdata[j]);
    128:     if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
    129:     else vdata[j] = 1.0;
    130:   }
    131:   VecRestoreArray(x,&vdata);
    132:   return(0);
    133: }

    137: static PetscErrorCode SolveLinearSystem(EPS eps)
    138: {
    140:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    141:   PetscInt       i,j,nmat,p_id;
    142:   Mat            A,B,Fz;
    143:   PC             pc;
    144:   Vec            BV;

    147:   STGetNumMatrices(eps->st,&nmat);
    148:   STGetOperators(eps->st,0,&A);
    149:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
    150:   else B = NULL;
    151:   MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&Fz);
    152:   VecDuplicate(ctx->V[0],&BV);

    154:   for (i=0;i<ctx->num_solve_point;i++) {
    155:     p_id = ctx->solver_comm_id * ctx->num_solve_point + i;
    156:     MatCopy(A,Fz,DIFFERENT_NONZERO_PATTERN);
    157:     if (nmat>1) {
    158:       MatAXPY(Fz,-ctx->omega[p_id],B,DIFFERENT_NONZERO_PATTERN);
    159:     } else {
    160:       MatShift(Fz,-ctx->omega[p_id]);
    161:     }
    162:     KSPSetOperators(ctx->ksp[i],Fz,Fz,SAME_NONZERO_PATTERN);
    163:     KSPSetType(ctx->ksp[i],KSPPREONLY);
    164:     KSPGetPC(ctx->ksp[i],&pc);
    165:     PCSetType(pc,PCREDUNDANT);
    166:     KSPSetFromOptions(ctx->ksp[i]);
    167:     for (j=0;j<ctx->L;j++) {
    168:       VecDuplicate(ctx->V[0],&ctx->Y[i*ctx->L_max+j]);
    169:       PetscLogObjectParent(eps,ctx->Y[i*ctx->L_max+j]);
    170:       if (nmat==2) {
    171:         MatMult(B,ctx->V[j],BV);
    172:         KSPSolve(ctx->ksp[i],BV,ctx->Y[i*ctx->L_max+j]);
    173:       } else {
    174:         KSPSolve(ctx->ksp[i],ctx->V[j],ctx->Y[i*ctx->L_max+j]);
    175:       }
    176:     }
    177:   }
    178:   MatDestroy(&Fz);
    179:   VecDestroy(&BV);
    180:   return(0);
    181: }

    185: static PetscErrorCode ConstructS(EPS eps,PetscInt M,Vec **S)
    186: {
    188:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    189:   PetscInt       i,j,k;
    190:   Vec            v;
    191:   PetscScalar    *ppk;

    194:   VecDuplicateVecs(ctx->Y[0],M*ctx->L,S);
    195:   PetscMalloc(ctx->num_solve_point*sizeof(PetscScalar),&ppk);
    196:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    197:   VecDuplicate(ctx->Y[0],&v);
    198:   for (k=0;k<M;k++) {
    199:     for (j=0;j<ctx->L;j++) {
    200:       VecSet(v,0);
    201:       for (i=0;i<ctx->num_solve_point; i++) {
    202:         VecAXPY(v,ppk[i]*ctx->weight[ctx->solver_comm_id*ctx->num_solve_point+i]/(PetscReal)ctx->N,ctx->Y[i*ctx->L_max+j]);
    203:       }
    204:       VecCopy(v,(*S)[k*ctx->L+j]);
    205:     }
    206:     for (i=0;i<ctx->num_solve_point;i++) {
    207:       ppk[i] *= ctx->pp[ctx->solver_comm_id*ctx->num_solve_point+i];
    208:     }
    209:   }
    210:   PetscFree(ppk);
    211:   VecDestroy(&v);
    212:   return(0);
    213: }

    217: static PetscErrorCode EstimateNumberEigs(EPS eps,Vec *S1,PetscInt *L_add)
    218: {
    220:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    221:   PetscInt       i,j,istart,p_start,p_end;
    222:   PetscScalar    *data,*p_data,tmp,sum = 0.0;
    223:   Vec            V_p;
    224:   PetscReal      eta;

    227:   VecGetOwnershipRange(ctx->V[0],&istart,NULL);
    228:   VecGetOwnershipRange(S1[0],&p_start,&p_end);

    230:   VecDuplicate(S1[0],&V_p);
    231:   for (i=0;i<ctx->L;i++) {
    232:     VecGetArray(ctx->V[i],&data);
    233:     VecGetArray(V_p,&p_data);
    234:     for (j=p_start;j<p_end;j++) p_data[j-p_start] = data[j-istart];
    235:     VecRestoreArray(ctx->V[i],&data);
    236:     VecRestoreArray(V_p,&p_data);
    237:     VecDot(V_p,S1[i],&tmp);
    238:     sum += tmp;
    239:   }
    240:   VecDestroy(&V_p);
    241:   ctx->est_eig = PetscAbsScalar(ctx->radius*sum/(PetscReal)ctx->L);
    242:   eta = PetscPowReal(10,-log10(eps->tol)/ctx->N);
    243:   PetscInfo1(eps,"Estimation_#Eig %F\n",ctx->est_eig);
    244:   *L_add = (PetscInt)ceil((ctx->est_eig*eta)/ctx->M) - ctx->L;
    245:   if (*L_add < 0) *L_add = 0;
    246:   if (*L_add>ctx->L_max-ctx->L) {
    247:     PetscInfo(eps,"Number of eigenvalues around the contour path may be too large\n");
    248:     *L_add = ctx->L_max-ctx->L;
    249:   }
    250:   return(0);
    251: }

    255: static PetscErrorCode SetAddVector(EPS eps,PetscInt Ladd_end)
    256: {
    258:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    259:   PetscInt       i,j,nlocal,Ladd_start=ctx->L;
    260:   Vec            *newV;
    261:   PetscScalar    *vdata;

    264:   PetscMalloc(Ladd_end*sizeof(Vec*),&newV);
    265:   for (i=0;i<ctx->L;i++) { newV[i] = ctx->V[i]; }
    266:   PetscFree(ctx->V);
    267:   ctx->V = newV;
    268:   VecGetLocalSize(ctx->V[0],&nlocal);
    269:   for (i=Ladd_start;i<Ladd_end;i++) {
    270:     VecDuplicate(ctx->V[0],&ctx->V[i]);
    271:     PetscLogObjectParent(eps,ctx->V[i]);
    272:     CISSVecSetRandom(ctx->V[i],eps->rand);
    273:     VecGetArray(ctx->V[i],&vdata);
    274:     for (j=0;j<nlocal;j++) {
    275:       vdata[j] = PetscRealPart(vdata[j]);
    276:       if (PetscRealPart(vdata[j]) < 0.5) vdata[j] = -1.0;
    277:       else vdata[j] = 1.0;
    278:     }
    279:     VecRestoreArray(ctx->V[i],&vdata);
    280:   }
    281:   return(0);
    282: }

    286: static PetscErrorCode SolveAddLinearSystem(EPS eps,PetscInt Ladd_start,PetscInt Ladd_end)
    287: {
    289:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    290:   PetscInt       i,j;

    293:   for (i=0;i<ctx->num_solve_point;i++) {
    294:     for (j=Ladd_start;j<Ladd_end;j++) {
    295:       VecDestroy(&ctx->Y[i*ctx->L_max+j]);
    296:       VecDuplicate(ctx->V[0],&ctx->Y[i*ctx->L_max+j]);
    297:       PetscLogObjectParent(eps,ctx->Y[i*ctx->L_max+j]);
    298:       KSPSolve(ctx->ksp[i],ctx->V[j],ctx->Y[i*ctx->L_max+j]);
    299:     }
    300:   }
    301:   return(0);
    302: }

    306: static PetscErrorCode CalcMu(EPS eps,PetscScalar *Mu)
    307: {
    309:   PetscInt       i,j,k,s;
    310:   PetscInt       rank_region,icolor,ikey;
    311:   PetscScalar    *temp,*temp2,*ppk,alp;
    312:   MPI_Comm       Row_Comm;
    313:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    316:   MPI_Comm_rank(PetscObjectComm((PetscObject)eps),&rank_region);
    317:   icolor = rank_region % ctx->npart;
    318:   ikey = rank_region / ctx->npart;
    319:   MPI_Comm_split(PetscObjectComm((PetscObject)eps),icolor,ikey,&Row_Comm);

    321:   PetscMalloc(ctx->num_solve_point*ctx->L*ctx->L*sizeof(PetscScalar),&temp);
    322:   PetscMalloc(2*ctx->M*ctx->L*ctx->L*sizeof(PetscScalar),&temp2);
    323:   PetscMalloc(ctx->num_solve_point*sizeof(PetscScalar),&ppk);
    324:   for (i=0;i<2*ctx->M*ctx->L*ctx->L;i++) temp2[i] = 0;
    325:   for (i=0; i<ctx->num_solve_point;i++) {
    326:     for (j=0;j<ctx->L;j++) {
    327:       VecMDot(ctx->Y[i*ctx->L_max+j],ctx->L,ctx->V,&temp[(j+i*ctx->L)*ctx->L]);
    328:     }
    329:   }

    331:   for (i=0;i<ctx->num_solve_point;i++) ppk[i] = 1;
    332:   for (k=0;k<2*ctx->M;k++) {
    333:     for (j=0;j<ctx->L;j++) {
    334:       for (i=0;i<ctx->num_solve_point;i++) {
    335:           alp = ppk[i]*ctx->weight[ctx->solver_comm_id*ctx->num_solve_point+i]/(PetscReal)ctx->N;
    336:         for (s=0;s<ctx->L;s++) {
    337:           if (ctx->useconj) temp2[s+(j+k*ctx->L)*ctx->L] += PetscRealPart(alp*temp[s+(j+i*ctx->L)*ctx->L])*2;
    338:           else temp2[s+(j+k*ctx->L)*ctx->L] += alp*temp[s+(j+i*ctx->L)*ctx->L];
    339:         }
    340:       }
    341:     }
    342:     for (i=0;i<ctx->num_solve_point;i++)
    343:       ppk[i] *= ctx->pp[ctx->solver_comm_id*ctx->num_solve_point+i];
    344:   }
    345:   MPI_Allreduce(temp2,Mu,2*ctx->M*ctx->L*ctx->L,MPIU_SCALAR,MPIU_SUM,Row_Comm);

    347:   PetscFree(ppk);
    348:   PetscFree(temp);
    349:   PetscFree(temp2);
    350:   return(0);
    351: }

    355: static PetscErrorCode BlockHankel(EPS eps,PetscScalar *Mu,PetscInt s,Vec *H)
    356: {
    357:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    358:   PetscInt       i,j,k,L=ctx->L,M=ctx->M;
    359:   PetscScalar    *H_data;

    363:   for (k=0;k<L*M;k++) {
    364:     VecGetArray(H[k],&H_data);
    365:     for (j=0;j<M;j++)
    366:       for (i=0;i<L;i++)
    367:         H_data[j*L+i] = Mu[i+k*L+(j+s)*L*L];
    368:     VecRestoreArray(H[k],&H_data);
    369:   }
    370:   return(0);
    371: }

    375: static PetscErrorCode SVD(EPS eps,Vec *Q,PetscInt *K,PetscBool isqr)
    376: {
    378:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    379:   PetscInt       i,j,k,ld,ml=ctx->L*ctx->M,n=eps->n;
    380:   PetscScalar    *R,*w,*s;
    381:   DS             ds;

    384:   if (isqr) {
    385:     PetscMalloc(ml*ml*sizeof(PetscScalar),&s);
    386:     PetscMemzero(s,ml*ml*sizeof(PetscScalar));
    387:     IPQRDecomposition(eps->ip,Q,0,ml,s,ml);
    388:   }

    390:   DSCreate(PETSC_COMM_WORLD,&ds);
    391:   DSSetType(ds,DSSVD);
    392:   DSSetFromOptions(ds);
    393:   ld = ml;
    394:   DSAllocate(ds,ld);
    395:   k = PetscMin(n,ml);
    396:   DSSetDimensions(ds,k,ml,0,0);
    397:   DSGetArray(ds,DS_MAT_A,&R);
    398:   if (isqr) {
    399:     for (i=0;i<ml;i++)
    400:       for (j=0;j<k;j++)
    401:         R[i*ld+j] = s[i*ml+j];
    402:   } else {
    403:     for (i=0;i<ml;i++) {
    404:       VecGetArray(Q[i],&s);
    405:       for (j=0;j<k;j++) {
    406:         R[i*ld+j] = s[j];
    407:       }
    408:       VecRestoreArray(Q[i],&s);
    409:     }
    410:   }
    411:   DSRestoreArray(ds,DS_MAT_A,&R);
    412:   if (isqr) { PetscFree(s); }
    413:   DSSetState(ds,DS_STATE_RAW);
    414:   PetscMalloc(k*sizeof(PetscScalar),&w);
    415:   DSSetEigenvalueComparison(ds,SlepcCompareLargestReal,NULL);
    416:   DSSolve(ds,w,NULL);
    417:   DSSort(ds,w,NULL,NULL,NULL,NULL);
    418:   (*K) = 0;
    419:   for (i=0;i<k;i++) {
    420:     ctx->sigma[i] = PetscRealPart(w[i]);
    421:     if (ctx->sigma[i]/PetscMax(ctx->sigma[0],1)>ctx->delta) (*K)++;
    422:   }
    423:   PetscFree(w);
    424:   DSDestroy(&ds);
    425:   return(0);
    426: }

    430: static PetscErrorCode ProjectMatrix(Mat A,PetscInt nv,PetscInt ld,Vec *Q,PetscScalar *H,Vec w,PetscBool isherm)
    431: {
    433:   PetscInt       i,j;

    436:   if (isherm) {
    437:     for (j=0;j<nv;j++) {
    438:       MatMult(A,Q[j],w);
    439:       VecMDot(w,j+1,Q,H+j*ld);
    440:       for (i=0;i<j;i++)
    441:         H[j+i*ld] = PetscConj(H[i+j*ld]);
    442:     }
    443:   } else {
    444:     for (j=0;j<nv;j++) {
    445:       MatMult(A,Q[j],w);
    446:       VecMDot(w,nv,Q,H+j*ld);
    447:     }
    448:   }
    449:   return(0);
    450: }

    454: static PetscErrorCode isInsideGamma(EPS eps,PetscInt nv,PetscBool *fl)
    455: {
    456:   EPS_CISS    *ctx = (EPS_CISS*)eps->data;
    457:   PetscInt    i;
    458:   PetscScalar d;
    459:   PetscReal   dx,dy;
    460:   for (i=0;i<nv;i++) {
    461:     d = (eps->eigr[i]-ctx->center)/ctx->radius;
    462:     dx = PetscRealPart(d);
    463:     dy = PetscImaginaryPart(d);
    464:     if ((dx*dx+(dy*dy)/(ctx->vscale*ctx->vscale))<=1) fl[i] = PETSC_TRUE;
    465:     else fl[i] = PETSC_FALSE;
    466:   }
    467:   return(0);
    468: }

    472: PetscErrorCode EPSSetUp_CISS(EPS eps)
    473: {
    475:   PetscInt       i;
    476:   Vec            stemp;
    477:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    478:   const char     *prefix;

    481: #if !defined(PETSC_USE_COMPLEX)
    482:   SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"CISS only works for complex scalars");
    483: #endif
    484:   eps->ncv = PetscMin(eps->n,ctx->L*ctx->M);
    485:   if (!eps->mpd) eps->mpd = eps->ncv;
    486:   if (!eps->which) eps->which = EPS_ALL;
    487:   if (!eps->extraction) {
    488:     EPSSetExtraction(eps,EPS_RITZ);
    489:   } else if (eps->extraction!=EPS_RITZ) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Unsupported extraction type");
    490:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");

    492:   if (ctx->isreal && PetscImaginaryPart(ctx->center) == 0.0) ctx->useconj = PETSC_TRUE;
    493:   else ctx->useconj = PETSC_FALSE;

    495:   if (!ctx->delta) ctx->delta = PetscMin((eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL*1e-1:eps->tol*1e-1),1e-12);

    497:   if (!ctx->vscale) {
    498:     if (eps->ishermitian && (eps->ispositive || !eps->isgeneralized) && PetscImaginaryPart(ctx->center) == 0.0) ctx->vscale = 0.1;
    499:     else ctx->vscale = 1.0;
    500:   }

    502:   /* create split comm */
    503:   SetSolverComm(eps);

    505:   EPSAllocateSolution(eps);
    506:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->weight);
    507:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->omega);
    508:   PetscMalloc(ctx->N*sizeof(PetscScalar),&ctx->pp);
    509:   PetscLogObjectMemory(eps,3*ctx->N*sizeof(PetscScalar));
    510:   PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);

    512:   /* create a template vector for Vecs on solver communicator */
    513:   VecCreateMPI(PetscObjectComm((PetscObject)eps),PETSC_DECIDE,eps->n,&stemp);
    514:   VecDuplicateVecs(stemp,ctx->L,&ctx->V);
    515:   PetscLogObjectParents(eps,ctx->L,ctx->V);
    516:   VecDestroy(&stemp);

    518:   PetscMalloc(ctx->num_solve_point*sizeof(KSP),&ctx->ksp);
    519:   PetscLogObjectMemory(eps,ctx->num_solve_point*sizeof(KSP));
    520:   for (i=0;i<ctx->num_solve_point;i++) {
    521:     KSPCreate(PetscObjectComm((PetscObject)eps),&ctx->ksp[i]);
    522:     PetscObjectIncrementTabLevel((PetscObject)ctx->ksp[i],(PetscObject)eps,1);
    523:     PetscLogObjectParent(eps,ctx->ksp[i]);
    524:     KSPAppendOptionsPrefix(ctx->ksp[i],"eps_ciss_");
    525:     EPSGetOptionsPrefix(eps,&prefix);
    526:     KSPAppendOptionsPrefix(ctx->ksp[i],prefix);
    527:   }
    528:   PetscMalloc(ctx->num_solve_point*ctx->L_max*sizeof(Vec),&ctx->Y);
    529:   PetscMemzero(ctx->Y,ctx->num_solve_point*ctx->L_max*sizeof(Vec));
    530:   PetscLogObjectMemory(eps,ctx->num_solve_point*ctx->L_max*sizeof(Vec));

    532:   if (eps->isgeneralized) {
    533:     if (eps->ishermitian && eps->ispositive) {
    534:       DSSetType(eps->ds,DSGHEP);
    535:     } else {
    536:       DSSetType(eps->ds,DSGNHEP);
    537:     }
    538:   } else {
    539:     if (eps->ishermitian) {
    540:       DSSetType(eps->ds,DSHEP);
    541:     } else {
    542:       DSSetType(eps->ds,DSNHEP);
    543:     }
    544:   }
    545:   DSAllocate(eps->ds,eps->ncv);
    546:   EPSSetWorkVecs(eps,2);

    548:   /* dispatch solve method */
    549:   if (eps->leftvecs) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Left vectors not supported in this solver");
    550:   eps->ops->solve = EPSSolve_CISS;
    551:   return(0);
    552: }

    556: PetscErrorCode EPSSolve_CISS(EPS eps)
    557: {
    559:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    560:   PetscInt       i,j,k,ld,nv,nmat,nvecs,L_add=0,inner,outer,L_base=ctx->L;
    561:   PetscScalar    *H,*rr,*pX,*tdata,*vdata,*Mu;
    562:   PetscReal      *tau,s1,s2,tau_max=0.0,*temp,error,max_error;
    563:   PetscBool      *fl;
    564:   Mat            A,B;
    565:   Vec            w=eps->work[0],tempv=eps->work[1],*H0,aux;

    568:   DSGetLeadingDimension(eps->ds,&ld);
    569:   STGetNumMatrices(eps->st,&nmat);
    570:   STGetOperators(eps->st,0,&A);
    571:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
    572:   else B = NULL;

    574:   SetPathParameter(eps);
    575:   for (i=0;i<ctx->L;i++) {
    576:     CISSVecSetRandom(ctx->V[i],eps->rand);
    577:   }
    578:   SolveLinearSystem(eps);
    579:   ConstructS(eps,1,&ctx->S);
    580:   nvecs = ctx->L;
    581:   EstimateNumberEigs(eps,ctx->S,&L_add);

    583:   if (L_add>0) {
    584:     PetscInfo2(eps,"Changing L %d -> %d by Estimate #Eig\n",ctx->L,ctx->L+L_add);
    585:     SetAddVector(eps,ctx->L+L_add);
    586:     SolveAddLinearSystem(eps,ctx->L,ctx->L+L_add);
    587:     ctx->L += L_add;
    588:     PetscFree(ctx->sigma);
    589:     PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);
    590:   }

    592:   for (i=0;i<ctx->refine_blocksize;i++) {
    593:     PetscMalloc(ctx->L*ctx->L*ctx->M*2*sizeof(PetscScalar),&Mu);
    594:     CalcMu(eps,Mu);
    595:     VecCreateMPI(PetscObjectComm((PetscObject)eps),PETSC_DECIDE,ctx->L*ctx->M,&aux);
    596:     VecDuplicateVecs(aux,ctx->L*ctx->M,&H0);
    597:     VecDestroy(&aux);
    598:     BlockHankel(eps,Mu,0,H0);
    599:     SVD(eps,H0,&nv,PETSC_FALSE);
    600:     PetscFree(Mu);
    601:     VecDestroyVecs(ctx->L*ctx->M,&H0);
    602:     if (ctx->sigma[0]<=ctx->delta || nv < ctx->L*ctx->M) break;
    603:     L_add = L_base;
    604:     PetscInfo2(eps,"Changing L %d -> %d by SVD(H0)\n",ctx->L,ctx->L+L_add);
    605:     SetAddVector(eps,ctx->L+L_add);
    606:     SolveAddLinearSystem(eps,ctx->L,ctx->L+L_add);
    607:     ctx->L += L_add;
    608:     PetscFree(ctx->sigma);
    609:     PetscMalloc(ctx->L*ctx->M*sizeof(PetscReal),&ctx->sigma);
    610:   }

    612:   if (ctx->L != L_base) {
    613:     eps->ncv = PetscMin(eps->n,ctx->L*ctx->M);
    614:     eps->mpd = eps->ncv;
    615:     EPSAllocateSolution(eps);
    616:     DSReset(eps->ds);
    617:     DSSetEigenvalueComparison(eps->ds,eps->comparison,eps->comparisonctx);
    618:     if (eps->isgeneralized) {
    619:       if (eps->ishermitian && eps->ispositive) {
    620:         DSSetType(eps->ds,DSGHEP);
    621:       } else {
    622:         DSSetType(eps->ds,DSGNHEP);
    623:       }
    624:     } else {
    625:       if (eps->ishermitian) {
    626:         DSSetType(eps->ds,DSHEP);
    627:       } else {
    628:         DSSetType(eps->ds,DSNHEP);
    629:       }
    630:     }
    631:     DSAllocate(eps->ds,eps->ncv);
    632:     DSGetLeadingDimension(eps->ds,&ld);
    633:   }

    635:   for (outer=0;outer<=ctx->refine_outer;outer++) {
    636:     for (inner=0;inner<=ctx->refine_inner;inner++) {
    637:       VecDestroyVecs(nvecs,&ctx->S);
    638:       ConstructS(eps,ctx->M,&ctx->S);
    639:       nvecs = ctx->M*ctx->L;
    640:       SVD(eps,ctx->S,&nv,PETSC_TRUE);
    641:       if (ctx->sigma[0]>ctx->delta && nv==ctx->L*ctx->M && inner!=ctx->refine_inner) {
    642:         for (i=0;i<ctx->L;i++) {
    643:           VecCopy(ctx->S[i],ctx->V[i]);
    644:         }
    645:         SolveAddLinearSystem(eps,0,ctx->L);
    646:       } else break;
    647:     }
    648:     eps->nconv = 0;
    649:     if (nv == 0) break;
    650:     DSSetDimensions(eps->ds,nv,0,0,0);
    651:     DSSetState(eps->ds,DS_STATE_RAW);

    653:     DSGetArray(eps->ds,DS_MAT_A,&H);
    654:     ProjectMatrix(A,nv,ld,ctx->S,H,w,eps->ishermitian);
    655:     DSRestoreArray(eps->ds,DS_MAT_A,&H);
    656:
    657:     if (nmat>1) {
    658:       DSGetArray(eps->ds,DS_MAT_B,&H);
    659:       ProjectMatrix(B,nv,ld,ctx->S,H,w,eps->ishermitian);
    660:       DSRestoreArray(eps->ds,DS_MAT_B,&H);
    661:     }
    662:
    663:     DSSolve(eps->ds,eps->eigr,NULL);

    665:     PetscMalloc(nv*sizeof(PetscReal),&tau);
    666:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    667:     DSGetArray(eps->ds,DS_MAT_X,&pX);
    668:     for (i=0;i<nv;i++) {
    669:       s1 = 0;
    670:       s2 = 0;
    671:       for (j=0;j<nv;j++) {
    672:         s1 += PetscAbsScalar(PetscPowScalar(pX[i*ld+j],2));
    673:         s2 += PetscPowScalar(PetscAbsScalar(pX[i*ld+j]),2)/ctx->sigma[j];
    674:       }
    675:       tau[i] = s1/s2;
    676:       tau_max = PetscMax(tau_max,tau[i]);
    677:     }
    678:     tau_max /= ctx->sigma[0];
    679:     DSRestoreArray(eps->ds,DS_MAT_X,&pX);
    680:     for (i=0;i<nv;i++) tau[i] /= tau_max;
    681:     PetscMalloc(nv*sizeof(PetscBool),&fl);
    682:     isInsideGamma(eps,nv,fl);
    683:     PetscMalloc(nv*sizeof(PetscScalar),&rr);
    684:     for (i=0;i<nv;i++) {
    685:       if (fl[i] && tau[i]>=ctx->spurious_threshold*tau_max) {
    686:         rr[i] = 1.0;
    687:         eps->nconv++;
    688:       } else rr[i] = 0.0;
    689:     }

    691:     PetscFree(tau);
    692:     PetscFree(fl);
    693:     DSSetEigenvalueComparison(eps->ds,SlepcCompareLargestMagnitude,NULL);
    694:     DSSort(eps->ds,eps->eigr,NULL,rr,NULL,&eps->nconv);
    695:     DSSetEigenvalueComparison(eps->ds,eps->comparison,eps->comparisonctx);
    696:     PetscFree(rr);
    697:     for (i=0;i<nv;i++) {
    698:       VecCopy(ctx->S[i],eps->V[i]);
    699:     }
    700:
    701:     DSVectors(eps->ds,DS_MAT_X,NULL,NULL);
    702:     DSGetArray(eps->ds,DS_MAT_X,&pX);
    703:     SlepcUpdateVectors(nv,ctx->S,0,eps->nconv,pX,ld,PETSC_FALSE);
    704:     if (eps->ishermitian) {  /* compute eigenvectors */
    705:       SlepcUpdateVectors(nv,eps->V,0,eps->nconv,pX,ld,PETSC_FALSE);
    706:     }
    707:     DSRestoreArray(eps->ds,DS_MAT_X,&pX);

    709:     max_error = 0.0;
    710:     for (i=0;i<eps->nconv;i++) {
    711:       VecNormalize(eps->V[i],NULL);
    712:       VecNormalize(ctx->S[i],NULL);
    713:       EPSComputeRelativeError_Private(eps,eps->eigr[i],0,ctx->S[i],NULL,&error);
    714:       max_error = PetscMax(max_error,error);
    715:     }
    716:     if (max_error <= eps->tol || outer == ctx->refine_outer) break;
    717:     PetscMalloc(ctx->L*eps->nconv*sizeof(PetscReal),&temp);
    718:     for (i=0;i<ctx->L*eps->nconv;i++) {
    719:       PetscRandomGetValueReal(eps->rand,&temp[i]);
    720:       temp[i] = 2*temp[i]-1;
    721:     }
    722:
    723:     for (k=0;k<ctx->L;k++) {
    724:       VecGetArray(tempv,&tdata);
    725:       for (j=0;j<eps->nconv;j++) {
    726:         VecGetArray(ctx->S[j],&vdata);
    727:         for (i=0;i<eps->n;i++) {
    728:           if (j==0) tdata[i] = vdata[i]*temp[j+eps->nconv*k];
    729:           else tdata[i] = tdata[i]+vdata[i]*temp[j+eps->nconv*k];
    730:         }
    731:         VecRestoreArray(ctx->S[j],&vdata);
    732:       }
    733:       VecRestoreArray(tempv,&tdata);
    734:       VecCopy(tempv,ctx->V[k]);
    735:     }
    736:
    737:     PetscFree(temp);
    738:     SolveAddLinearSystem(eps,0,ctx->L);
    739:   }
    740:   eps->reason = EPS_CONVERGED_TOL;
    741:   return(0);
    742: }

    746: static PetscErrorCode EPSCISSSetRegion_CISS(EPS eps,PetscScalar center,PetscReal radius,PetscReal vscale)
    747: {
    748:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    751:   ctx->center = center;
    752:   if (radius) {
    753:     if (radius == PETSC_DEFAULT) {
    754:       ctx->radius = 1.0;
    755:     } else {
    756:       if (radius<0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The radius argument must be > 0.0");
    757:       ctx->radius = radius;
    758:     }
    759:   }
    760:   if (vscale) {
    761:     if (vscale<0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The vscale argument must be > 0.0");
    762:     ctx->vscale = vscale;
    763:   }
    764:   return(0);
    765: }

    769: /*@
    770:    EPSCISSSetRegion - Sets the parameters defining the region where eigenvalues
    771:    must be computed.

    773:    Logically Collective on EPS

    775:    Input Parameters:
    776: +  eps - the eigenproblem solver context
    777: .  center - center of the region
    778: .  radius - radius of the region
    779: -  vscale - vertical scale of the region

    781:    Options Database Keys:
    782: +  -eps_ciss_center - Sets the center
    783: .  -eps_ciss_radius - Sets the radius
    784: -  -eps_ciss_vscale - Sets the vertical scale

    786:    Level: advanced

    788: .seealso: EPSCISSGetRegion()
    789: @*/
    790: PetscErrorCode EPSCISSSetRegion(EPS eps,PetscScalar center,PetscReal radius,PetscReal vscale)
    791: {

    799:   PetscTryMethod(eps,"EPSCISSSetRegion_C",(EPS,PetscScalar,PetscReal,PetscReal),(eps,center,radius,vscale));
    800:   return(0);
    801: }

    805: static PetscErrorCode EPSCISSGetRegion_CISS(EPS eps,PetscScalar *center,PetscReal *radius,PetscReal *vscale)
    806: {
    807:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    810:   if (center) *center = ctx->center;
    811:   if (radius) *radius = ctx->radius;
    812:   if (vscale) *vscale = ctx->vscale;
    813:   return(0);
    814: }

    818: /*@
    819:    EPSCISSGetRegion - Gets the parameters that define the region where eigenvalues
    820:    must be computed.

    822:    Not Collective

    824:    Input Parameter:
    825: .  eps - the eigenproblem solver context

    827:    Output Parameters:
    828: +  center - center of the region
    829: .  radius - radius of the region
    830: -  vscale - vertical scale of the region

    832:    Level: advanced

    834: .seealso: EPSCISSSetRegion()
    835: @*/
    836: PetscErrorCode EPSCISSGetRegion(EPS eps,PetscScalar *center,PetscReal *radius,PetscReal *vscale)
    837: {

    842:   PetscTryMethod(eps,"EPSCISSGetRegion_C",(EPS,PetscScalar*,PetscReal*,PetscReal*),(eps,center,radius,vscale));
    843:   return(0);
    844: }

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

    854:   if (ip) {
    855:     if (ip == PETSC_DECIDE || ip == PETSC_DEFAULT) {
    856:       if (ctx->N!=32) { ctx->N =32; ctx->M = ctx->N/4; }
    857:     } else {
    858:       if (ip<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be > 0");
    859:       if (ip%2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ip argument must be an even number");
    860:       if (ctx->N!=ip) { ctx->N = ip; ctx->M = ctx->N/4; }
    861:     }
    862:   }
    863:   if (bs) {
    864:     if (bs == PETSC_DECIDE || bs == PETSC_DEFAULT) {
    865:       ctx->L = 16;
    866:     } else {
    867:       if (bs<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bs argument must be > 0");
    868:       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");
    869:       ctx->L = bs;
    870:     }
    871:   }
    872:   if (ms) {
    873:     if (ms == PETSC_DECIDE || ms == PETSC_DEFAULT) {
    874:       ctx->M = ctx->N/4;
    875:     } else {
    876:       if (ms<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The ms argument must be > 0");
    877:       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");
    878:       ctx->M = ms;
    879:     }
    880:   }
    881:   if (npart) {
    882:     if (npart == PETSC_DECIDE || npart == PETSC_DEFAULT) {
    883:       ctx->npart = 1;
    884:     } else {
    885:       if (npart<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The npart argument must be > 0");
    886:       ctx->npart = npart;
    887:     }
    888:   }
    889:   if (bsmax) {
    890:     if (bsmax == PETSC_DECIDE || bsmax == PETSC_DEFAULT) {
    891:       ctx->L = 256;
    892:     } else {
    893:       if (bsmax<1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The bsmax argument must be > 0");
    894:       if (bsmax<ctx->L) ctx->L_max = ctx->L;
    895:       else ctx->L_max = bsmax;
    896:     }
    897:   }
    898:   ctx->isreal = isreal;
    899:   EPSReset(eps);   /* clean allocated arrays and force new setup */
    900:   return(0);
    901: }

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

    908:    Logically Collective on EPS

    910:    Input Parameters:
    911: +  eps   - the eigenproblem solver context
    912: .  ip    - number of integration points
    913: .  bs    - block size
    914: .  ms    - moment size
    915: .  npart - number of partitions when splitting the communicator
    916: .  bsmax - max block size
    917: -  isreal - A and B are real

    919:    Options Database Keys:
    920: +  -eps_ciss_integration_points - Sets the number of integration points
    921: .  -eps_ciss_blocksize - Sets the block size
    922: .  -eps_ciss_moments - Sets the moment size
    923: .  -eps_ciss_partitions - Sets the number of partitions
    924: .  -eps_ciss_maxblocksize - Sets the maximum block size
    925: -  -eps_ciss_realmats - A and B are real

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

    932:    Level: advanced

    934: .seealso: EPSCISSGetSizes()
    935: @*/
    936: PetscErrorCode EPSCISSSetSizes(EPS eps,PetscInt ip,PetscInt bs,PetscInt ms,PetscInt npart,PetscInt bsmax,PetscBool isreal)
    937: {

    948:   PetscTryMethod(eps,"EPSCISSSetSizes_C",(EPS,PetscInt,PetscInt,PetscInt,PetscInt,PetscInt,PetscBool),(eps,ip,bs,ms,npart,bsmax,isreal));
    949:   return(0);
    950: }

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

    959:   if (ip) *ip = ctx->N;
    960:   if (bs) *bs = ctx->L;
    961:   if (ms) *ms = ctx->M;
    962:   if (npart) *npart = ctx->npart;
    963:   if (bsmax) *bsmax = ctx->L_max;
    964:   if (isreal) *isreal = ctx->isreal;
    965:   return(0);
    966: }

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

    973:    Not Collective

    975:    Input Parameter:
    976: .  eps - the eigenproblem solver context

    978:    Output Parameters:
    979: +  ip    - number of integration points
    980: .  bs    - block size
    981: .  ms    - moment size
    982: .  npart - number of partitions when splitting the communicator
    983: .  bsmax - max block size
    984: -  isreal - A and B are real

    986:    Level: advanced

    988: .seealso: EPSCISSSetSizes()
    989: @*/
    990: PetscErrorCode EPSCISSGetSizes(EPS eps,PetscInt *ip,PetscInt *bs,PetscInt *ms,PetscInt *npart,PetscInt *bsmax,PetscBool *isreal)
    991: {

    996:   PetscTryMethod(eps,"EPSCISSGetSizes_C",(EPS,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,PetscBool*),(eps,ip,bs,ms,npart,bsmax,isreal));
    997:   return(0);
    998: }

    1002: static PetscErrorCode EPSCISSSetThreshold_CISS(EPS eps,PetscReal delta,PetscReal spur)
    1003: {
    1004:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1007:   if (delta) {
    1008:     if (delta == PETSC_DEFAULT) {
    1009:       ctx->delta = 1e-12;
    1010:     } else {
    1011:       if (delta<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The delta argument must be > 0.0");
    1012:       ctx->delta = delta;
    1013:     }
    1014:   }
    1015:   if (spur) {
    1016:     if (spur == PETSC_DEFAULT) {
    1017:       ctx->spurious_threshold = 1e-4;
    1018:     } else {
    1019:       if (spur<=0.0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The spurious threshold argument must be > 0.0");
    1020:       ctx->spurious_threshold = spur;
    1021:     }
    1022:   }
    1023:   return(0);
    1024: }

    1028: /*@
    1029:    EPSCISSSetThreshold - Sets the values of various threshold parameters in
    1030:    the CISS solver.

    1032:    Logically Collective on EPS

    1034:    Input Parameters:
    1035: +  eps   - the eigenproblem solver context
    1036: .  delta - threshold for numerical rank
    1037: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1039:    Options Database Keys:
    1040: +  -eps_ciss_delta - Sets the delta
    1041: -  -eps_ciss_spurious_threshold - Sets the spurious threshold

    1043:    Level: advanced

    1045: .seealso: EPSCISSGetThreshold()
    1046: @*/
    1047: PetscErrorCode EPSCISSSetThreshold(EPS eps,PetscReal delta,PetscReal spur)
    1048: {

    1055:   PetscTryMethod(eps,"EPSCISSSetThreshold_C",(EPS,PetscReal,PetscReal),(eps,delta,spur));
    1056:   return(0);
    1057: }

    1061: static PetscErrorCode EPSCISSGetThreshold_CISS(EPS eps,PetscReal *delta,PetscReal *spur)
    1062: {
    1063:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1066:   if (delta) *delta = ctx->delta;
    1067:   if (spur)  *spur = ctx->spurious_threshold;
    1068:   return(0);
    1069: }

    1073: /*@
    1074:    EPSCISSGetThreshold - Gets the values of various threshold parameters
    1075:    in the CISS solver.

    1077:    Not Collective

    1079:    Input Parameter:
    1080: .  eps - the eigenproblem solver context

    1082:    Output Parameters:
    1083: +  delta - threshold for numerical rank
    1084: -  spur  - spurious threshold (to discard spurious eigenpairs)

    1086:    Level: advanced

    1088: .seealso: EPSCISSSetThreshold()
    1089: @*/
    1090: PetscErrorCode EPSCISSGetThreshold(EPS eps,PetscReal *delta,PetscReal *spur)
    1091: {

    1096:   PetscTryMethod(eps,"EPSCISSGetThreshold_C",(EPS,PetscReal*,PetscReal*),(eps,delta,spur));
    1097:   return(0);
    1098: }

    1102: static PetscErrorCode EPSCISSSetRefinement_CISS(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
    1103: {
    1104:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1107:   if (inner == PETSC_DEFAULT) {
    1108:     ctx->refine_inner = 0;
    1109:   } else {
    1110:     if (inner<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine inner argument must be >= 0");
    1111:     ctx->refine_inner = inner;
    1112:   }
    1113:   if (outer == PETSC_DEFAULT) {
    1114:     ctx->refine_outer = 0;
    1115:   } else {
    1116:     if (outer<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine outer argument must be >= 0");
    1117:     ctx->refine_outer = outer;
    1118:   }
    1119:   if (blsize == PETSC_DEFAULT) {
    1120:     ctx->refine_blocksize = 0;
    1121:   } else {
    1122:     if (blsize<0) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The refine blocksize argument must be >= 0");
    1123:     ctx->refine_blocksize = blsize;
    1124:   }
    1125:   return(0);
    1126: }

    1130: /*@
    1131:    EPSCISSSetRefinement - Sets the values of various refinement parameters
    1132:    in the CISS solver.

    1134:    Logically Collective on EPS

    1136:    Input Parameters:
    1137: +  eps    - the eigenproblem solver context
    1138: .  inner  - number of iterative refinement iterations (inner loop)
    1139: .  outer  - number of iterative refinement iterations (outer loop)
    1140: -  blsize - number of iterative refinement iterations (blocksize loop)

    1142:    Options Database Keys:
    1143: +  -eps_ciss_refine_inner - Sets number of inner iterations
    1144: .  -eps_ciss_refine_outer - Sets number of outer iterations
    1145: -  -eps_ciss_refine_blocksize - Sets number of blocksize iterations

    1147:    Level: advanced

    1149: .seealso: EPSCISSGetRefinement()
    1150: @*/
    1151: PetscErrorCode EPSCISSSetRefinement(EPS eps,PetscInt inner,PetscInt outer,PetscInt blsize)
    1152: {

    1160:   PetscTryMethod(eps,"EPSCISSSetRefinement_C",(EPS,PetscInt,PetscInt,PetscInt),(eps,inner,outer,blsize));
    1161:   return(0);
    1162: }

    1166: static PetscErrorCode EPSCISSGetRefinement_CISS(EPS eps,PetscInt *inner,PetscInt *outer,PetscInt *blsize)
    1167: {
    1168:   EPS_CISS *ctx = (EPS_CISS*)eps->data;

    1171:   if (inner)  *inner = ctx->refine_inner;
    1172:   if (outer)  *outer = ctx->refine_outer;
    1173:   if (blsize) *blsize = ctx->refine_blocksize;
    1174:   return(0);
    1175: }

    1179: /*@
    1180:    EPSCISSGetRefinement - Gets the values of various refinement parameters
    1181:    in the CISS solver.

    1183:    Not Collective

    1185:    Input Parameter:
    1186: .  eps - the eigenproblem solver context

    1188:    Output Parameters:
    1189: +  inner  - number of iterative refinement iterations (inner loop)
    1190: .  outer  - number of iterative refinement iterations (outer loop)
    1191: -  blsize - number of iterative refinement iterations (blocksize loop)

    1193:    Level: advanced

    1195: .seealso: EPSCISSSetRefinement()
    1196: @*/
    1197: PetscErrorCode EPSCISSGetRefinement(EPS eps, PetscInt *inner, PetscInt *outer,PetscInt *blsize)
    1198: {

    1203:   PetscTryMethod(eps,"EPSCISSGetRefinement_C",(EPS,PetscInt*,PetscInt*,PetscInt*),(eps,inner,outer,blsize));
    1204:   return(0);
    1205: }

    1209: PetscErrorCode EPSReset_CISS(EPS eps)
    1210: {
    1212:   PetscInt       i;
    1213:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    1216:   PetscFree(ctx->weight);
    1217:   PetscFree(ctx->omega);
    1218:   PetscFree(ctx->pp);
    1219:   VecDestroyVecs(ctx->L,&ctx->V);
    1220:   for (i=0;i<ctx->num_solve_point;i++) {
    1221:     KSPDestroy(&ctx->ksp[i]);
    1222:   }
    1223:   PetscFree(ctx->ksp);
    1224:   PetscFree(ctx->sigma);
    1225:   for (i=0;i<ctx->num_solve_point*ctx->L_max;i++) {
    1226:     VecDestroy(&ctx->Y[i]);
    1227:   }
    1228:   PetscFree(ctx->Y);
    1229:   VecDestroyVecs(ctx->M*ctx->L,&ctx->S);
    1230:   EPSReset_Default(eps);
    1231:   return(0);
    1232: }

    1236: PetscErrorCode EPSSetFromOptions_CISS(EPS eps)
    1237: {
    1239:   PetscScalar    s;
    1240:   PetscReal      r1,r2,r3,r4;
    1241:   PetscInt       i1=0,i2=0,i3=0,i4=0,i5=0,i6=0,i7=0,i8=0;
    1242:   PetscBool      b1=PETSC_FALSE;

    1245:   PetscOptionsHead("EPS CISS Options");
    1246:   EPSCISSGetRegion(eps,&s,&r1,&r2);
    1247:   PetscOptionsReal("-eps_ciss_radius","CISS radius of region","EPSCISSSetRegion",r1,&r1,NULL);
    1248:   PetscOptionsScalar("-eps_ciss_center","CISS center of region","EPSCISSSetRegion",s,&s,NULL);
    1249:   PetscOptionsReal("-eps_ciss_vscale","CISS vertical scale of region","EPSCISSSetRegion",r2,&r2,NULL);
    1250:   EPSCISSSetRegion(eps,s,r1,r2);

    1252:   PetscOptionsInt("-eps_ciss_integration_points","CISS number of integration points","EPSCISSSetSizes",i1,&i1,NULL);
    1253:   PetscOptionsInt("-eps_ciss_blocksize","CISS block size","EPSCISSSetSizes",i2,&i2,NULL);
    1254:   PetscOptionsInt("-eps_ciss_moments","CISS moment size","EPSCISSSetSizes",i3,&i3,NULL);
    1255:   PetscOptionsInt("-eps_ciss_partitions","CISS number of partitions","EPSCISSSetSizes",i4,&i4,NULL);
    1256:   PetscOptionsInt("-eps_ciss_maxblocksize","CISS maximum block size","EPSCISSSetSizes",i5,&i5,NULL);
    1257:   PetscOptionsBool("-eps_ciss_realmats","CISS A and B are real","EPSCISSSetSizes",b1,&b1,NULL);
    1258:   EPSCISSSetSizes(eps,i1,i2,i3,i4,i5,b1);

    1260:   EPSCISSGetThreshold(eps,&r3,&r4);
    1261:   PetscOptionsReal("-eps_ciss_delta","CISS threshold for numerical rank","EPSCISSSetThreshold",r3,&r3,NULL);
    1262:   PetscOptionsReal("-eps_ciss_spurious_threshold","CISS threshold for the spurious eigenpairs","EPSCISSSetThreshold",r4,&r4,NULL);
    1263:   EPSCISSSetThreshold(eps,r3,r4);

    1265:   EPSCISSGetRefinement(eps,&i6,&i7,&i8);
    1266:   PetscOptionsInt("-eps_ciss_refine_inner","CISS number of inner iterative refinement iterations","EPSCISSSetRefinement",i6,&i6,NULL);
    1267:   PetscOptionsInt("-eps_ciss_refine_outer","CISS number of outer iterative refinement iterations","EPSCISSSetRefinement",i7,&i7,NULL);
    1268:   PetscOptionsInt("-eps_ciss_refine_blocksize","CISS number of blocksize iterative refinement iterations","EPSCISSSetRefinement",i8,&i8,NULL);
    1269:   EPSCISSSetRefinement(eps,i6,i7,i8);

    1271:   PetscOptionsTail();
    1272:   return(0);
    1273: }

    1277: PetscErrorCode EPSDestroy_CISS(EPS eps)
    1278: {

    1282:   PetscFree(eps->data);
    1283:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRegion_C",NULL);
    1284:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRegion_C",NULL);
    1285:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",NULL);
    1286:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",NULL);
    1287:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",NULL);
    1288:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",NULL);
    1289:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",NULL);
    1290:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",NULL);
    1291:   return(0);
    1292: }

    1296: PetscErrorCode EPSView_CISS(EPS eps,PetscViewer viewer)
    1297: {
    1299:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;
    1300:   PetscBool      isascii;
    1301:   char           str[50];

    1304:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    1305:   if (isascii) {
    1306:     SlepcSNPrintfScalar(str,50,ctx->center,PETSC_FALSE);
    1307:     PetscViewerASCIIPrintf(viewer,"  CISS: region { center: %s, radius: %G, vscale: %G }\n",str,ctx->radius,ctx->vscale);
    1308:     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->npart,ctx->L_max);
    1309:     if (ctx->isreal) {
    1310:       PetscViewerASCIIPrintf(viewer,"  CISS: exploiting symmetry of integration points\n");
    1311:     }
    1312:     PetscViewerASCIIPrintf(viewer,"  CISS: threshold { delta: %G, spurious threshold: %G }\n",ctx->delta,ctx->spurious_threshold);
    1313:     PetscViewerASCIIPrintf(viewer,"  CISS: iterative refinement  { inner: %D, outer: %D, blocksize: %D }\n",ctx->refine_inner,ctx->refine_outer, ctx->refine_blocksize);
    1314:     PetscViewerASCIIPushTab(viewer);
    1315:     KSPView(ctx->ksp[0],viewer);
    1316:     PetscViewerASCIIPopTab(viewer);

    1318:   }
    1319:   return(0);
    1320: }

    1324: PETSC_EXTERN PetscErrorCode EPSCreate_CISS(EPS eps)
    1325: {
    1327:   EPS_CISS       *ctx = (EPS_CISS*)eps->data;

    1330:   PetscNewLog(eps,EPS_CISS,&ctx);
    1331:   eps->data = ctx;
    1332:   eps->ops->setup          = EPSSetUp_CISS;
    1333:   eps->ops->setfromoptions = EPSSetFromOptions_CISS;
    1334:   eps->ops->destroy        = EPSDestroy_CISS;
    1335:   eps->ops->reset          = EPSReset_CISS;
    1336:   eps->ops->view           = EPSView_CISS;
    1337:   eps->ops->backtransform  = PETSC_NULL;
    1338:   eps->ops->computevectors = EPSComputeVectors_Schur;
    1339:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRegion_C",EPSCISSSetRegion_CISS);
    1340:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRegion_C",EPSCISSGetRegion_CISS);
    1341:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetSizes_C",EPSCISSSetSizes_CISS);
    1342:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetSizes_C",EPSCISSGetSizes_CISS);
    1343:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetThreshold_C",EPSCISSSetThreshold_CISS);
    1344:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetThreshold_C",EPSCISSGetThreshold_CISS);
    1345:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSSetRefinement_C",EPSCISSSetRefinement_CISS);
    1346:   PetscObjectComposeFunction((PetscObject)eps,"EPSCISSGetRefinement_C",EPSCISSGetRefinement_CISS);
    1347:   /* set default values of parameters */
    1348:   ctx->center  = 0.0;
    1349:   ctx->radius  = 1.0;
    1350:   ctx->vscale  = 0.0;
    1351:   ctx->N       = 32;
    1352:   ctx->L       = 16;
    1353:   ctx->M       = ctx->N/4;
    1354:   ctx->delta   = 0;
    1355:   ctx->npart   = 1;
    1356:   ctx->L_max   = 128;
    1357:   ctx->spurious_threshold = 1e-4;
    1358:   ctx->isreal  = PETSC_FALSE;
    1359:   ctx->refine_outer = 1;
    1360:   ctx->refine_inner = 1;
    1361:   ctx->refine_blocksize = 1;
    1362:   return(0);
    1363: }