Date: 2022-08-09T09:05:49+00:00

Actual source code: qslice.c
slepc-3.17.2 2022-08-09
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.
      7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: */
     10: /*
     11:    SLEPc polynomial eigensolver: "stoar"

     13:    Method: S-TOAR with spectrum slicing for symmetric quadratic eigenproblems

     15:    Algorithm:

     17:        Symmetric Two-Level Orthogonal Arnoldi.

     19:    References:

     21:        [1] C. Campos and J.E. Roman, "Inertia-based spectrum slicing
     22:            for symmetric quadratic eigenvalue problems", Numer. Linear
     23:            Algebra Appl. 27(4):e2293, 2020.
     24: */

     26: #include <slepc/private/pepimpl.h>
     27: #include "../src/pep/impls/krylov/pepkrylov.h"
     28: #include <slepcblaslapack.h>

     30: static PetscBool  cited = PETSC_FALSE;
     31: static const char citation[] =
     32:   "@Article{slepc-slice-qep,\n"
     33:   "   author = \"C. Campos and J. E. Roman\",\n"
     34:   "   title = \"Inertia-based spectrum slicing for symmetric quadratic eigenvalue problems\",\n"
     35:   "   journal = \"Numer. Linear Algebra Appl.\",\n"
     36:   "   volume = \"27\",\n"
     37:   "   number = \"4\",\n"
     38:   "   pages = \"e2293\",\n"
     39:   "   year = \"2020,\"\n"
     40:   "   doi = \"https://doi.org/10.1002/nla.2293\"\n"
     41:   "}\n";

     43: #define SLICE_PTOL PETSC_SQRT_MACHINE_EPSILON

     45: static PetscErrorCode PEPQSliceResetSR(PEP pep)
     46: {
     47:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
     48:   PEP_SR         sr=ctx->sr;
     49:   PEP_shift      s;
     50:   PetscInt       i;

     52:   if (sr) {
     53:     /* Reviewing list of shifts to free memory */
     54:     s = sr->s0;
     55:     if (s) {
     56:       while (s->neighb[1]) {
     57:         s = s->neighb[1];
     58:         PetscFree(s->neighb[0]);
     59:       }
     60:       PetscFree(s);
     61:     }
     62:     PetscFree(sr->S);
     63:     for (i=0;i<pep->nconv;i++) PetscFree(sr->qinfo[i].q);
     64:     PetscFree(sr->qinfo);
     65:     for (i=0;i<3;i++) VecDestroy(&sr->v[i]);
     66:     EPSDestroy(&sr->eps);
     67:     PetscFree(sr);
     68:   }
     69:   ctx->sr = NULL;
     70:   PetscFunctionReturn(0);
     71: }

     73: PetscErrorCode PEPReset_STOAR_QSlice(PEP pep)
     74: {
     75:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;

     77:   PEPQSliceResetSR(pep);
     78:   PetscFree(ctx->inertias);
     79:   PetscFree(ctx->shifts);
     80:   PetscFunctionReturn(0);
     81: }

     83: /*
     84:   PEPQSliceAllocateSolution - Allocate memory storage for common variables such
     85:   as eigenvalues and eigenvectors.
     86: */
     87: static PetscErrorCode PEPQSliceAllocateSolution(PEP pep)
     88: {
     89:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
     90:   PetscInt       k;
     91:   PetscLogDouble cnt;
     92:   BVType         type;
     93:   Vec            t;
     94:   PEP_SR         sr = ctx->sr;

     96:   /* allocate space for eigenvalues and friends */
     97:   k = PetscMax(1,sr->numEigs);
     98:   PetscFree4(sr->eigr,sr->eigi,sr->errest,sr->perm);
     99:   PetscCalloc4(k,&sr->eigr,k,&sr->eigi,k,&sr->errest,k,&sr->perm);
    100:   PetscFree(sr->qinfo);
    101:   PetscCalloc1(k,&sr->qinfo);
    102:   cnt = 2*k*sizeof(PetscScalar) + 2*k*sizeof(PetscReal) + k*sizeof(PetscInt);
    103:   PetscLogObjectMemory((PetscObject)pep,cnt);

    105:   /* allocate sr->V and transfer options from pep->V */
    106:   BVDestroy(&sr->V);
    107:   BVCreate(PetscObjectComm((PetscObject)pep),&sr->V);
    108:   PetscLogObjectParent((PetscObject)pep,(PetscObject)sr->V);
    109:   if (!pep->V) PEPGetBV(pep,&pep->V);
    110:   if (!((PetscObject)(pep->V))->type_name) BVSetType(sr->V,BVSVEC);
    111:   else {
    112:     BVGetType(pep->V,&type);
    113:     BVSetType(sr->V,type);
    114:   }
    115:   STMatCreateVecsEmpty(pep->st,&t,NULL);
    116:   BVSetSizesFromVec(sr->V,t,k+1);
    117:   VecDestroy(&t);
    118:   sr->ld = k;
    119:   PetscFree(sr->S);
    120:   PetscMalloc1((k+1)*sr->ld*(pep->nmat-1),&sr->S);
    121:   PetscFunctionReturn(0);
    122: }

    124: /* Convergence test to compute positive Ritz values */
    125: static PetscErrorCode ConvergedPositive(EPS eps,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
    126: {
    127:   *errest = (PetscRealPart(eigr)>0.0)?0.0:res;
    128:   PetscFunctionReturn(0);
    129: }

    131: static PetscErrorCode PEPQSliceMatGetInertia(PEP pep,PetscReal shift,PetscInt *inertia,PetscInt *zeros)
    132: {
    133:   KSP            ksp,kspr;
    134:   PC             pc;
    135:   Mat            F;
    136:   PetscBool      flg;

    138:   if (!pep->solvematcoeffs) PetscMalloc1(pep->nmat,&pep->solvematcoeffs);
    139:   if (shift==PETSC_MAX_REAL) { /* Inertia of matrix A[2] */
    140:     pep->solvematcoeffs[0] = 0.0; pep->solvematcoeffs[1] = 0.0; pep->solvematcoeffs[2] = 1.0;
    141:   } else PEPEvaluateBasis(pep,shift,0,pep->solvematcoeffs,NULL);
    142:   STMatSetUp(pep->st,pep->sfactor,pep->solvematcoeffs);
    143:   STGetKSP(pep->st,&ksp);
    144:   KSPGetPC(ksp,&pc);
    145:   PetscObjectTypeCompare((PetscObject)pc,PCREDUNDANT,&flg);
    146:   if (flg) {
    147:     PCRedundantGetKSP(pc,&kspr);
    148:     KSPGetPC(kspr,&pc);
    149:   }
    150:   PCFactorGetMatrix(pc,&F);
    151:   MatGetInertia(F,inertia,zeros,NULL);
    152:   PetscFunctionReturn(0);
    153: }

    155: static PetscErrorCode PEPQSliceGetInertia(PEP pep,PetscReal shift,PetscInt *inertia,PetscInt *zeros,PetscInt correction)
    156: {
    157:   KSP            ksp;
    158:   Mat            P;
    159:   PetscReal      nzshift=0.0,dot;
    160:   PetscRandom    rand;
    161:   PetscInt       nconv;
    162:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    163:   PEP_SR         sr=ctx->sr;

    165:   if (shift >= PETSC_MAX_REAL) { /* Right-open interval */
    166:     *inertia = 0;
    167:   } else if (shift <= PETSC_MIN_REAL) {
    168:     *inertia = 0;
    169:     if (zeros) *zeros = 0;
    170:   } else {
    171:     /* If the shift is zero, perturb it to a very small positive value.
    172:        The goal is that the nonzero pattern is the same in all cases and reuse
    173:        the symbolic factorizations */
    174:     nzshift = (shift==0.0)? 10.0/PETSC_MAX_REAL: shift;
    175:     PEPQSliceMatGetInertia(pep,nzshift,inertia,zeros);
    176:     STSetShift(pep->st,nzshift);
    177:   }
    178:   if (!correction) {
    179:     if (shift >= PETSC_MAX_REAL) *inertia = 2*pep->n;
    180:     else if (shift>PETSC_MIN_REAL) {
    181:       STGetKSP(pep->st,&ksp);
    182:       KSPGetOperators(ksp,&P,NULL);
    183:       if (*inertia!=pep->n && !sr->v[0]) {
    184:         MatCreateVecs(P,&sr->v[0],NULL);
    185:         VecDuplicate(sr->v[0],&sr->v[1]);
    186:         VecDuplicate(sr->v[0],&sr->v[2]);
    187:         BVGetRandomContext(pep->V,&rand);
    188:         VecSetRandom(sr->v[0],rand);
    189:       }
    190:       if (*inertia<pep->n && *inertia>0) {
    191:         if (!sr->eps) {
    192:           EPSCreate(PetscObjectComm((PetscObject)pep),&sr->eps);
    193:           EPSSetProblemType(sr->eps,EPS_HEP);
    194:           EPSSetWhichEigenpairs(sr->eps,EPS_LARGEST_REAL);
    195:         }
    196:         EPSSetConvergenceTestFunction(sr->eps,ConvergedPositive,NULL,NULL);
    197:         EPSSetOperators(sr->eps,P,NULL);
    198:         EPSSolve(sr->eps);
    199:         EPSGetConverged(sr->eps,&nconv);
    201:         EPSGetEigenpair(sr->eps,0,NULL,NULL,sr->v[0],sr->v[1]);
    202:       }
    203:       if (*inertia!=pep->n) {
    204:         MatMult(pep->A[1],sr->v[0],sr->v[1]);
    205:         MatMult(pep->A[2],sr->v[0],sr->v[2]);
    206:         VecAXPY(sr->v[1],2*nzshift,sr->v[2]);
    207:         VecDotRealPart(sr->v[1],sr->v[0],&dot);
    208:         if (dot>0.0) *inertia = 2*pep->n-*inertia;
    209:       }
    210:     }
    211:   } else if (correction<0) *inertia = 2*pep->n-*inertia;
    212:   PetscFunctionReturn(0);
    213: }

    215: /*
    216:    Check eigenvalue type - used only in non-hyperbolic problems.
    217:    All computed eigenvalues must have the same definite type (positive or negative).
    218:    If ini=TRUE the type is available in omega, otherwise we compute an eigenvalue
    219:    closest to shift and determine its type.
    220:  */
    221: static PetscErrorCode PEPQSliceCheckEigenvalueType(PEP pep,PetscReal shift,PetscReal omega,PetscBool ini)
    222: {
    223:   PEP            pep2;
    224:   ST             st;
    225:   PetscInt       nconv;
    226:   PetscScalar    lambda;
    227:   PetscReal      dot;
    228:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    229:   PEP_SR         sr=ctx->sr;

    231:   if (!ini) {
    233:   } else {
    234:     PEPCreate(PetscObjectComm((PetscObject)pep),&pep2);
    235:     PEPSetOptionsPrefix(pep2,((PetscObject)pep)->prefix);
    236:     PEPAppendOptionsPrefix(pep2,"pep_eigenvalue_type_");
    237:     PEPSetTolerances(pep2,PETSC_DEFAULT,pep->max_it/4);
    238:     PEPSetType(pep2,PEPTOAR);
    239:     PEPSetOperators(pep2,pep->nmat,pep->A);
    240:     PEPSetWhichEigenpairs(pep2,PEP_TARGET_MAGNITUDE);
    241:     PEPGetRG(pep2,&pep2->rg);
    242:     RGSetType(pep2->rg,RGINTERVAL);
    243: #if defined(PETSC_USE_COMPLEX)
    244:     RGIntervalSetEndpoints(pep2->rg,pep->inta,pep->intb,-PETSC_SQRT_MACHINE_EPSILON,PETSC_SQRT_MACHINE_EPSILON);
    245: #else
    246:     RGIntervalSetEndpoints(pep2->rg,pep->inta,pep->intb,0.0,0.0);
    247: #endif
    248:     pep2->target = shift;
    249:     st = pep2->st;
    250:     pep2->st = pep->st;
    251:     PEPSolve(pep2);
    252:     PEPGetConverged(pep2,&nconv);
    253:     if (nconv) {
    254:       PEPGetEigenpair(pep2,0,&lambda,NULL,pep2->work[0],NULL);
    255:       MatMult(pep->A[1],pep2->work[0],pep2->work[1]);
    256:       MatMult(pep->A[2],pep2->work[0],pep2->work[2]);
    257:       VecAXPY(pep2->work[1],2.0*lambda*pep->sfactor,pep2->work[2]);
    258:       VecDotRealPart(pep2->work[1],pep2->work[0],&dot);
    259:       PetscInfo(pep,"lambda=%g, %s type\n",(double)PetscRealPart(lambda),(dot>0.0)?"positive":"negative");
    260:       if (!sr->type) sr->type = (dot>0.0)?1:-1;
    262:     }
    263:     pep2->st = st;
    264:     PEPDestroy(&pep2);
    265:   }
    266:   PetscFunctionReturn(0);
    267: }

    269: static inline PetscErrorCode PEPQSliceDiscriminant(PEP pep,Vec u,Vec w,PetscReal *d,PetscReal *smas,PetscReal *smenos)
    270: {
    271:   PetscReal      ap,bp,cp,dis;

    273:   MatMult(pep->A[0],u,w);
    274:   VecDotRealPart(w,u,&cp);
    275:   MatMult(pep->A[1],u,w);
    276:   VecDotRealPart(w,u,&bp);
    277:   MatMult(pep->A[2],u,w);
    278:   VecDotRealPart(w,u,&ap);
    279:   dis = bp*bp-4*ap*cp;
    280:   if (dis>=0.0 && smas) {
    281:     if (ap>0) *smas = (-bp+PetscSqrtReal(dis))/(2*ap);
    282:     else if (ap<0) *smas = (-bp-PetscSqrtReal(dis))/(2*ap);
    283:     else {
    284:       if (bp >0) *smas = -cp/bp;
    285:       else *smas = PETSC_MAX_REAL;
    286:     }
    287:   }
    288:   if (dis>=0.0 && smenos) {
    289:     if (ap>0) *smenos = (-bp-PetscSqrtReal(dis))/(2*ap);
    290:     else if (ap<0) *smenos = (-bp+PetscSqrtReal(dis))/(2*ap);
    291:     else {
    292:       if (bp<0) *smenos = -cp/bp;
    293:       else *smenos = PETSC_MAX_REAL;
    294:     }
    295:   }
    296:   if (d) *d = dis;
    297:   PetscFunctionReturn(0);
    298: }

    300: static inline PetscErrorCode PEPQSliceEvaluateQEP(PEP pep,PetscScalar x,Mat M,MatStructure str)
    301: {
    302:   MatCopy(pep->A[0],M,SAME_NONZERO_PATTERN);
    303:   MatAXPY(M,x,pep->A[1],str);
    304:   MatAXPY(M,x*x,pep->A[2],str);
    305:   PetscFunctionReturn(0);
    306: }

    308: /*@
    309:    PEPCheckDefiniteQEP - Determines if a symmetric/Hermitian quadratic eigenvalue problem
    310:    is definite or not.

    312:    Logically Collective on pep

    314:    Input Parameter:
    315: .  pep  - eigensolver context

    317:    Output Parameters:
    318: +  xi - first computed parameter
    319: .  mu - second computed parameter
    320: .  definite - flag indicating that the problem is definite
    321: -  hyperbolic - flag indicating that the problem is hyperbolic

    323:    Notes:
    324:    This function is intended for quadratic eigenvalue problems, Q(lambda)=A*lambda^2+B*lambda+C,
    325:    with symmetric (or Hermitian) coefficient matrices A,B,C.

    327:    On output, the flag 'definite' may have the values -1 (meaning that the QEP is not
    328:    definite), 1 (if the problem is definite), or 0 if the algorithm was not able to
    329:    determine whether the problem is definite or not.

    331:    If definite=1, the output flag 'hyperbolic' informs in a similar way about whether the
    332:    problem is hyperbolic or not.

    334:    If definite=1, the computed values xi and mu satisfy Q(xi)<0 and Q(mu)>0, as
    335:    obtained via the method proposed in [Niendorf and Voss, LAA 2010]. Furthermore, if
    336:    hyperbolic=1 then only xi is computed.

    338:    Level: advanced

    340: .seealso: PEPSetProblemType()
    341: @*/
    342: PetscErrorCode PEPCheckDefiniteQEP(PEP pep,PetscReal *xi,PetscReal *mu,PetscInt *definite,PetscInt *hyperbolic)
    343: {
    344:   PetscRandom    rand;
    345:   Vec            u,w;
    346:   PetscReal      d=0.0,s=0.0,sp,mut=0.0,omg=0.0,omgp;
    347:   PetscInt       k,its=10,hyp=0,check=0,nconv,inertia,n;
    348:   Mat            M=NULL;
    349:   MatStructure   str;
    350:   EPS            eps;
    351:   PetscBool      transform,ptypehyp;

    354:   ptypehyp = (pep->problem_type==PEP_HYPERBOLIC)? PETSC_TRUE: PETSC_FALSE;
    355:   if (!pep->st) PEPGetST(pep,&pep->st);
    356:   PEPSetDefaultST(pep);
    357:   STSetMatrices(pep->st,pep->nmat,pep->A);
    358:   MatGetSize(pep->A[0],&n,NULL);
    359:   STGetTransform(pep->st,&transform);
    360:   STSetTransform(pep->st,PETSC_FALSE);
    361:   STSetUp(pep->st);
    362:   MatCreateVecs(pep->A[0],&u,&w);
    363:   PEPGetBV(pep,&pep->V);
    364:   BVGetRandomContext(pep->V,&rand);
    365:   VecSetRandom(u,rand);
    366:   VecNormalize(u,NULL);
    367:   PEPQSliceDiscriminant(pep,u,w,&d,&s,NULL);
    368:   if (d<0.0) check = -1;
    369:   if (!check) {
    370:     EPSCreate(PetscObjectComm((PetscObject)pep),&eps);
    371:     EPSSetProblemType(eps,EPS_HEP);
    372:     EPSSetWhichEigenpairs(eps,EPS_LARGEST_REAL);
    373:     EPSSetTolerances(eps,PetscSqrtReal(PETSC_SQRT_MACHINE_EPSILON),PETSC_DECIDE);
    374:     MatDuplicate(pep->A[0],MAT_DO_NOT_COPY_VALUES,&M);
    375:     STGetMatStructure(pep->st,&str);
    376:   }
    377:   for (k=0;k<its&&!check;k++) {
    378:     PEPQSliceEvaluateQEP(pep,s,M,str);
    379:     EPSSetOperators(eps,M,NULL);
    380:     EPSSolve(eps);
    381:     EPSGetConverged(eps,&nconv);
    382:     if (!nconv) break;
    383:     EPSGetEigenpair(eps,0,NULL,NULL,u,w);
    384:     sp = s;
    385:     PEPQSliceDiscriminant(pep,u,w,&d,&s,&omg);
    386:     if (d<0.0) {check = -1; break;}
    387:     if (PetscAbsReal((s-sp)/s)<100*PETSC_MACHINE_EPSILON) break;
    388:     if (s>sp) {hyp = -1;}
    389:     mut = 2*s-sp;
    390:     PEPQSliceMatGetInertia(pep,mut,&inertia,NULL);
    391:     if (inertia == n) {check = 1; break;}
    392:   }
    393:   for (;k<its&&!check;k++) {
    394:     mut = (s-omg)/2;
    395:     PEPQSliceMatGetInertia(pep,mut,&inertia,NULL);
    396:     if (inertia == n) {check = 1; break;}
    397:     if (PetscAbsReal((s-omg)/omg)<100*PETSC_MACHINE_EPSILON) break;
    398:     PEPQSliceEvaluateQEP(pep,omg,M,str);
    399:     EPSSetOperators(eps,M,NULL);
    400:     EPSSolve(eps);
    401:     EPSGetConverged(eps,&nconv);
    402:     if (!nconv) break;
    403:     EPSGetEigenpair(eps,0,NULL,NULL,u,w);
    404:     omgp = omg;
    405:     PEPQSliceDiscriminant(pep,u,w,&d,NULL,&omg);
    406:     if (d<0.0) {check = -1; break;}
    407:     if (omg<omgp) hyp = -1;
    408:   }
    409:   if (check==1) *xi = mut;
    411:   if (check==1 && hyp==0) {
    412:     PEPQSliceMatGetInertia(pep,PETSC_MAX_REAL,&inertia,NULL);
    413:     if (inertia == 0) hyp = 1;
    414:     else hyp = -1;
    415:   }
    416:   if (check==1 && hyp!=1) {
    417:     check = 0;
    418:     EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);
    419:     for (;k<its&&!check;k++) {
    420:       PEPQSliceEvaluateQEP(pep,s,M,str);
    421:       EPSSetOperators(eps,M,NULL);
    422:       EPSSolve(eps);
    423:       EPSGetConverged(eps,&nconv);
    424:       if (!nconv) break;
    425:       EPSGetEigenpair(eps,0,NULL,NULL,u,w);
    426:       sp = s;
    427:       PEPQSliceDiscriminant(pep,u,w,&d,&s,&omg);
    428:       if (d<0.0) {check = -1; break;}
    429:       if (PetscAbsReal((s-sp)/s)<100*PETSC_MACHINE_EPSILON) break;
    430:       mut = 2*s-sp;
    431:       PEPQSliceMatGetInertia(pep,mut,&inertia,NULL);
    432:       if (inertia == 0) {check = 1; break;}
    433:     }
    434:     for (;k<its&&!check;k++) {
    435:       mut = (s-omg)/2;
    436:       PEPQSliceMatGetInertia(pep,mut,&inertia,NULL);
    437:       if (inertia == 0) {check = 1; break;}
    438:       if (PetscAbsReal((s-omg)/omg)<100*PETSC_MACHINE_EPSILON) break;
    439:       PEPQSliceEvaluateQEP(pep,omg,M,str);
    440:       EPSSetOperators(eps,M,NULL);
    441:       EPSSolve(eps);
    442:       EPSGetConverged(eps,&nconv);
    443:       if (!nconv) break;
    444:       EPSGetEigenpair(eps,0,NULL,NULL,u,w);
    445:       PEPQSliceDiscriminant(pep,u,w,&d,NULL,&omg);
    446:       if (d<0.0) {check = -1; break;}
    447:     }
    448:   }
    449:   if (check==1) *mu = mut;
    450:   *definite = check;
    451:   *hyperbolic = hyp;
    452:   if (M) MatDestroy(&M);
    453:   VecDestroy(&u);
    454:   VecDestroy(&w);
    455:   EPSDestroy(&eps);
    456:   STSetTransform(pep->st,transform);
    457:   PetscFunctionReturn(0);
    458: }

    460: /*
    461:    Dummy backtransform operation
    462:  */
    463: static PetscErrorCode PEPBackTransform_Skip(PEP pep)
    464: {
    465:   PetscFunctionReturn(0);
    466: }

    468: PetscErrorCode PEPSetUp_STOAR_QSlice(PEP pep)
    469: {
    470:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    471:   PEP_SR         sr;
    472:   PetscInt       ld,i,zeros=0;
    473:   SlepcSC        sc;
    474:   PetscReal      r;

    476:   PEPCheckSinvertCayley(pep);
    479:   PEPCheckUnsupportedCondition(pep,PEP_FEATURE_STOPPING,PETSC_TRUE," (with spectrum slicing)");
    480:   if (pep->tol==PETSC_DEFAULT) {
    481: #if defined(PETSC_USE_REAL_SINGLE)
    482:     pep->tol = SLEPC_DEFAULT_TOL;
    483: #else
    484:     /* use tighter tolerance */
    485:     pep->tol = SLEPC_DEFAULT_TOL*1e-2;
    486: #endif
    487:   }
    488:   if (ctx->nev==1) ctx->nev = PetscMin(20,pep->n);  /* nev not set, use default value */
    490:   pep->ops->backtransform = PEPBackTransform_Skip;
    491:   if (pep->max_it==PETSC_DEFAULT) pep->max_it = 100;

    493:   /* create spectrum slicing context and initialize it */
    494:   PEPQSliceResetSR(pep);
    495:   PetscNewLog(pep,&sr);
    496:   ctx->sr   = sr;
    497:   sr->itsKs = 0;
    498:   sr->nleap = 0;
    499:   sr->sPres = NULL;

    501:   if (pep->solvematcoeffs) PetscFree(pep->solvematcoeffs);
    502:   PetscMalloc1(pep->nmat,&pep->solvematcoeffs);
    503:   if (!pep->st) PEPGetST(pep,&pep->st);
    504:   STSetTransform(pep->st,PETSC_FALSE);
    505:   STSetUp(pep->st);

    507:   ctx->hyperbolic = (pep->problem_type==PEP_HYPERBOLIC)? PETSC_TRUE: PETSC_FALSE;

    509:   /* check presence of ends and finding direction */
    510:   if (pep->inta > PETSC_MIN_REAL || pep->intb >= PETSC_MAX_REAL) {
    511:     sr->int0 = pep->inta;
    512:     sr->int1 = pep->intb;
    513:     sr->dir = 1;
    514:     if (pep->intb >= PETSC_MAX_REAL) { /* Right-open interval */
    515:       sr->hasEnd = PETSC_FALSE;
    516:     } else sr->hasEnd = PETSC_TRUE;
    517:   } else {
    518:     sr->int0 = pep->intb;
    519:     sr->int1 = pep->inta;
    520:     sr->dir = -1;
    521:     sr->hasEnd = PetscNot(pep->inta <= PETSC_MIN_REAL);
    522:   }

    524:   /* compute inertia0 */
    525:   PEPQSliceGetInertia(pep,sr->int0,&sr->inertia0,ctx->detect?&zeros:NULL,ctx->hyperbolic?0:1);
    527:   if (!ctx->hyperbolic && ctx->checket) PEPQSliceCheckEigenvalueType(pep,sr->int0,0.0,PETSC_TRUE);

    529:   /* compute inertia1 */
    530:   PEPQSliceGetInertia(pep,sr->int1,&sr->inertia1,ctx->detect?&zeros:NULL,ctx->hyperbolic?0:1);
    532:   if (!ctx->hyperbolic && ctx->checket && sr->hasEnd) {
    533:     PEPQSliceCheckEigenvalueType(pep,sr->int1,0.0,PETSC_TRUE);
    536:     if (sr->dir*(sr->inertia1-sr->inertia0)<0) {
    537:       sr->intcorr = -1;
    538:       sr->inertia0 = 2*pep->n-sr->inertia0;
    539:       sr->inertia1 = 2*pep->n-sr->inertia1;
    540:     } else sr->intcorr = 1;
    541:   } else {
    542:     if (sr->inertia0<=pep->n && sr->inertia1<=pep->n) sr->intcorr = 1;
    543:     else if (sr->inertia0>=pep->n && sr->inertia1>=pep->n) sr->intcorr = -1;
    544:   }

    546:   if (sr->hasEnd) {
    547:     sr->dir = -sr->dir; r = sr->int0; sr->int0 = sr->int1; sr->int1 = r;
    548:     i = sr->inertia0; sr->inertia0 = sr->inertia1; sr->inertia1 = i;
    549:   }

    551:   /* number of eigenvalues in interval */
    552:   sr->numEigs = (sr->dir)*(sr->inertia1 - sr->inertia0);
    553:   PetscInfo(pep,"QSlice setup: allocating for %" PetscInt_FMT " eigenvalues in [%g,%g]\n",sr->numEigs,(double)pep->inta,(double)pep->intb);
    554:   if (sr->numEigs) {
    555:     PEPQSliceAllocateSolution(pep);
    556:     PEPSetDimensions_Default(pep,ctx->nev,&ctx->ncv,&ctx->mpd);
    557:     pep->nev = ctx->nev; pep->ncv = ctx->ncv; pep->mpd = ctx->mpd;
    558:     ld   = ctx->ncv+2;
    559:     DSSetType(pep->ds,DSGHIEP);
    560:     DSSetCompact(pep->ds,PETSC_TRUE);
    561:     DSSetExtraRow(pep->ds,PETSC_TRUE);
    562:     DSAllocate(pep->ds,ld);
    563:     DSGetSlepcSC(pep->ds,&sc);
    564:     sc->rg            = NULL;
    565:     sc->comparison    = SlepcCompareLargestMagnitude;
    566:     sc->comparisonctx = NULL;
    567:     sc->map           = NULL;
    568:     sc->mapobj        = NULL;
    569:   } else {pep->ncv = 0; pep->nev = 0; pep->mpd = 0;}
    570:   PetscFunctionReturn(0);
    571: }

    573: /*
    574:    Fills the fields of a shift structure
    575: */
    576: static PetscErrorCode PEPCreateShift(PEP pep,PetscReal val,PEP_shift neighb0,PEP_shift neighb1)
    577: {
    578:   PEP_shift      s,*pending2;
    579:   PetscInt       i;
    580:   PEP_SR         sr;
    581:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;

    583:   sr = ctx->sr;
    584:   PetscNewLog(pep,&s);
    585:   s->value = val;
    586:   s->neighb[0] = neighb0;
    587:   if (neighb0) neighb0->neighb[1] = s;
    588:   s->neighb[1] = neighb1;
    589:   if (neighb1) neighb1->neighb[0] = s;
    590:   s->comp[0] = PETSC_FALSE;
    591:   s->comp[1] = PETSC_FALSE;
    592:   s->index = -1;
    593:   s->neigs = 0;
    594:   s->nconv[0] = s->nconv[1] = 0;
    595:   s->nsch[0] = s->nsch[1]=0;
    596:   /* Inserts in the stack of pending shifts */
    597:   /* If needed, the array is resized */
    598:   if (sr->nPend >= sr->maxPend) {
    599:     sr->maxPend *= 2;
    600:     PetscMalloc1(sr->maxPend,&pending2);
    601:     PetscLogObjectMemory((PetscObject)pep,sr->maxPend*sizeof(PEP_shift*));
    602:     for (i=0;i<sr->nPend;i++) pending2[i] = sr->pending[i];
    603:     PetscFree(sr->pending);
    604:     sr->pending = pending2;
    605:   }
    606:   sr->pending[sr->nPend++]=s;
    607:   PetscFunctionReturn(0);
    608: }

    610: /* Provides next shift to be computed */
    611: static PetscErrorCode PEPExtractShift(PEP pep)
    612: {
    613:   PetscInt       iner,zeros=0;
    614:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    615:   PEP_SR         sr;
    616:   PetscReal      newShift,aux;
    617:   PEP_shift      sPres;

    619:   sr = ctx->sr;
    620:   if (sr->nPend > 0) {
    621:     if (sr->dirch) {
    622:       aux = sr->int1; sr->int1 = sr->int0; sr->int0 = aux;
    623:       iner = sr->inertia1; sr->inertia1 = sr->inertia0; sr->inertia0 = iner;
    624:       sr->dir *= -1;
    625:       PetscFree(sr->s0->neighb[1]);
    626:       PetscFree(sr->s0);
    627:       sr->nPend--;
    628:       PEPCreateShift(pep,sr->int0,NULL,NULL);
    629:       sr->sPrev = NULL;
    630:       sr->sPres = sr->pending[--sr->nPend];
    631:       pep->target = sr->sPres->value;
    632:       sr->s0 = sr->sPres;
    633:       pep->reason = PEP_CONVERGED_ITERATING;
    634:     } else {
    635:       sr->sPrev = sr->sPres;
    636:       sr->sPres = sr->pending[--sr->nPend];
    637:     }
    638:     sPres = sr->sPres;
    639:     PEPQSliceGetInertia(pep,sPres->value,&iner,ctx->detect?&zeros:NULL,sr->intcorr);
    640:     if (zeros) {
    641:       newShift = sPres->value*(1.0+SLICE_PTOL);
    642:       if (sr->dir*(sPres->neighb[0] && newShift-sPres->neighb[0]->value) < 0) newShift = (sPres->value+sPres->neighb[0]->value)/2;
    643:       else if (sPres->neighb[1] && sr->dir*(sPres->neighb[1]->value-newShift) < 0) newShift = (sPres->value+sPres->neighb[1]->value)/2;
    644:       PEPQSliceGetInertia(pep,newShift,&iner,&zeros,sr->intcorr);
    646:       sPres->value = newShift;
    647:     }
    648:     sr->sPres->inertia = iner;
    649:     pep->target = sr->sPres->value;
    650:     pep->reason = PEP_CONVERGED_ITERATING;
    651:     pep->its = 0;
    652:   } else sr->sPres = NULL;
    653:   PetscFunctionReturn(0);
    654: }

    656: /*
    657:   Obtains value of subsequent shift
    658: */
    659: static PetscErrorCode PEPGetNewShiftValue(PEP pep,PetscInt side,PetscReal *newS)
    660: {
    661:   PetscReal lambda,d_prev;
    662:   PetscInt  i,idxP;
    663:   PEP_SR    sr;
    664:   PEP_shift sPres,s;
    665:   PEP_STOAR *ctx=(PEP_STOAR*)pep->data;

    667:   sr = ctx->sr;
    668:   sPres = sr->sPres;
    669:   if (sPres->neighb[side]) {
    670:   /* Completing a previous interval */
    671:     if (!sPres->neighb[side]->neighb[side] && sPres->neighb[side]->nconv[side]==0) { /* One of the ends might be too far from eigenvalues */
    672:       if (side) *newS = (sPres->value + PetscRealPart(sr->eigr[sr->perm[sr->indexEig-1]]))/2;
    673:       else *newS = (sPres->value + PetscRealPart(sr->eigr[sr->perm[0]]))/2;
    674:     } else *newS=(sPres->value + sPres->neighb[side]->value)/2;
    675:   } else { /* (Only for side=1). Creating a new interval. */
    676:     if (sPres->neigs==0) {/* No value has been accepted*/
    677:       if (sPres->neighb[0]) {
    678:         /* Multiplying by 10 the previous distance */
    679:         *newS = sPres->value + 10*(sr->dir)*PetscAbsReal(sPres->value - sPres->neighb[0]->value);
    680:         sr->nleap++;
    681:         /* Stops when the interval is open and no values are found in the last 5 shifts (there might be infinite eigenvalues) */
    683:       } else { /* First shift */
    684:         if (pep->nconv != 0) {
    685:           /* Unaccepted values give information for next shift */
    686:           idxP=0;/* Number of values left from shift */
    687:           for (i=0;i<pep->nconv;i++) {
    688:             lambda = PetscRealPart(pep->eigr[i]);
    689:             if ((sr->dir)*(lambda - sPres->value) <0) idxP++;
    690:             else break;
    691:           }
    692:           /* Avoiding subtraction of eigenvalues (might be the same).*/
    693:           if (idxP>0) {
    694:             d_prev = PetscAbsReal(sPres->value - PetscRealPart(pep->eigr[0]))/(idxP+0.3);
    695:           } else {
    696:             d_prev = PetscAbsReal(sPres->value - PetscRealPart(pep->eigr[pep->nconv-1]))/(pep->nconv+0.3);
    697:           }
    698:           *newS = sPres->value + ((sr->dir)*d_prev*pep->nev)/2;
    699:           sr->dirch = PETSC_FALSE;
    700:         } else { /* No values found, no information for next shift */
    702:           sr->dirch = PETSC_TRUE;
    703:           *newS = sr->int1;
    704:         }
    705:       }
    706:     } else { /* Accepted values found */
    707:       sr->dirch = PETSC_FALSE;
    708:       sr->nleap = 0;
    709:       /* Average distance of values in previous subinterval */
    710:       s = sPres->neighb[0];
    711:       while (s && PetscAbs(s->inertia - sPres->inertia)==0) {
    712:         s = s->neighb[0];/* Looking for previous shifts with eigenvalues within */
    713:       }
    714:       if (s) {
    715:         d_prev = PetscAbsReal((sPres->value - s->value)/(sPres->inertia - s->inertia));
    716:       } else { /* First shift. Average distance obtained with values in this shift */
    717:         /* first shift might be too far from first wanted eigenvalue (no values found outside the interval)*/
    718:         if ((sr->dir)*(PetscRealPart(sr->eigr[0])-sPres->value)>0 && PetscAbsReal((PetscRealPart(sr->eigr[sr->indexEig-1]) - PetscRealPart(sr->eigr[0]))/PetscRealPart(sr->eigr[0])) > PetscSqrtReal(pep->tol)) {
    719:           d_prev =  PetscAbsReal((PetscRealPart(sr->eigr[sr->indexEig-1]) - PetscRealPart(sr->eigr[0])))/(sPres->neigs+0.3);
    720:         } else {
    721:           d_prev = PetscAbsReal(PetscRealPart(sr->eigr[sr->indexEig-1]) - sPres->value)/(sPres->neigs+0.3);
    722:         }
    723:       }
    724:       /* Average distance is used for next shift by adding it to value on the right or to shift */
    725:       if ((sr->dir)*(PetscRealPart(sr->eigr[sPres->index + sPres->neigs -1]) - sPres->value)>0) {
    726:         *newS = PetscRealPart(sr->eigr[sPres->index + sPres->neigs -1])+ ((sr->dir)*d_prev*(pep->nev))/2;
    727:       } else { /* Last accepted value is on the left of shift. Adding to shift */
    728:         *newS = sPres->value + ((sr->dir)*d_prev*(pep->nev))/2;
    729:       }
    730:     }
    731:     /* End of interval can not be surpassed */
    732:     if ((sr->dir)*(sr->int1 - *newS) < 0) *newS = sr->int1;
    733:   }/* of neighb[side]==null */
    734:   PetscFunctionReturn(0);
    735: }

    737: /*
    738:   Function for sorting an array of real values
    739: */
    740: static PetscErrorCode sortRealEigenvalues(PetscScalar *r,PetscInt *perm,PetscInt nr,PetscBool prev,PetscInt dir)
    741: {
    742:   PetscReal re;
    743:   PetscInt  i,j,tmp;

    745:   if (!prev) for (i=0;i<nr;i++) perm[i] = i;
    746:   /* Insertion sort */
    747:   for (i=1;i<nr;i++) {
    748:     re = PetscRealPart(r[perm[i]]);
    749:     j = i-1;
    750:     while (j>=0 && dir*(re - PetscRealPart(r[perm[j]])) <= 0) {
    751:       tmp = perm[j]; perm[j] = perm[j+1]; perm[j+1] = tmp; j--;
    752:     }
    753:   }
    754:   PetscFunctionReturn(0);
    755: }

    757: /* Stores the pairs obtained since the last shift in the global arrays */
    758: static PetscErrorCode PEPStoreEigenpairs(PEP pep)
    759: {
    760:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    761:   PetscReal      lambda,err,*errest;
    762:   PetscInt       i,*aux,count=0,ndef,ld,nconv=pep->nconv,d=pep->nmat-1,idx;
    763:   PetscBool      iscayley,divide=PETSC_FALSE;
    764:   PEP_SR         sr = ctx->sr;
    765:   PEP_shift      sPres;
    766:   Vec            w,vomega;
    767:   Mat            MS;
    768:   BV             tV;
    769:   PetscScalar    *S,*eigr,*tS,*omega;

    771:   sPres = sr->sPres;
    772:   sPres->index = sr->indexEig;

    774:   if (nconv>sr->ndef0+sr->ndef1) {
    775:     /* Back-transform */
    776:     STBackTransform(pep->st,nconv,pep->eigr,pep->eigi);
    777:     for (i=0;i<nconv;i++) {
    778: #if defined(PETSC_USE_COMPLEX)
    779:       if (PetscImaginaryPart(pep->eigr[i])) pep->eigr[i] = sr->int0-sr->dir;
    780: #else
    781:       if (pep->eigi[i]) pep->eigr[i] = sr->int0-sr->dir;
    782: #endif
    783:     }
    784:     PetscObjectTypeCompare((PetscObject)pep->st,STCAYLEY,&iscayley);
    785:     /* Sort eigenvalues */
    786:     sortRealEigenvalues(pep->eigr,pep->perm,nconv,PETSC_FALSE,sr->dir);
    787:     VecCreateSeq(PETSC_COMM_SELF,nconv,&vomega);
    788:     BVGetSignature(ctx->V,vomega);
    789:     VecGetArray(vomega,&omega);
    790:     BVGetSizes(pep->V,NULL,NULL,&ld);
    791:     BVTensorGetFactors(ctx->V,NULL,&MS);
    792:     MatDenseGetArray(MS,&S);
    793:     /* Values stored in global array */
    794:     PetscCalloc4(nconv,&eigr,nconv,&errest,nconv*nconv*d,&tS,nconv,&aux);
    795:     ndef = sr->ndef0+sr->ndef1;
    796:     for (i=0;i<nconv;i++) {
    797:       lambda = PetscRealPart(pep->eigr[pep->perm[i]]);
    798:       err = pep->errest[pep->perm[i]];
    799:       if ((sr->dir)*(lambda - sPres->ext[0]) > 0 && (sr->dir)*(sPres->ext[1] - lambda) > 0) {/* Valid value */
    801:         PEPQSliceCheckEigenvalueType(pep,lambda,PetscRealPart(omega[pep->perm[i]]),PETSC_FALSE);
    802:         eigr[count] = lambda;
    803:         errest[count] = err;
    804:         if (((sr->dir)*(sPres->value - lambda) > 0) && ((sr->dir)*(lambda - sPres->ext[0]) > 0)) sPres->nconv[0]++;
    805:         if (((sr->dir)*(lambda - sPres->value) > 0) && ((sr->dir)*(sPres->ext[1] - lambda) > 0)) sPres->nconv[1]++;
    806:         PetscArraycpy(tS+count*(d*nconv),S+pep->perm[i]*(d*ld),nconv);
    807:         PetscArraycpy(tS+count*(d*nconv)+nconv,S+pep->perm[i]*(d*ld)+ld,nconv);
    808:         count++;
    809:       }
    810:     }
    811:     VecRestoreArray(vomega,&omega);
    812:     VecDestroy(&vomega);
    813:     for (i=0;i<count;i++) {
    814:       PetscArraycpy(S+i*(d*ld),tS+i*nconv*d,nconv);
    815:       PetscArraycpy(S+i*(d*ld)+ld,tS+i*nconv*d+nconv,nconv);
    816:     }
    817:     MatDenseRestoreArray(MS,&S);
    818:     BVTensorRestoreFactors(ctx->V,NULL,&MS);
    819:     BVSetActiveColumns(ctx->V,0,count);
    820:     BVTensorCompress(ctx->V,count);
    821:     if (sr->sPres->nconv[0] && sr->sPres->nconv[1]) {
    822:       divide = PETSC_TRUE;
    823:       BVTensorGetFactors(ctx->V,NULL,&MS);
    824:       MatDenseGetArray(MS,&S);
    825:       PetscArrayzero(tS,nconv*nconv*d);
    826:       for (i=0;i<count;i++) {
    827:         PetscArraycpy(tS+i*nconv*d,S+i*(d*ld),count);
    828:         PetscArraycpy(tS+i*nconv*d+nconv,S+i*(d*ld)+ld,count);
    829:       }
    830:       MatDenseRestoreArray(MS,&S);
    831:       BVTensorRestoreFactors(ctx->V,NULL,&MS);
    832:       BVSetActiveColumns(pep->V,0,count);
    833:       BVDuplicateResize(pep->V,count,&tV);
    834:       BVCopy(pep->V,tV);
    835:     }
    836:     if (sr->sPres->nconv[0]) {
    837:       if (divide) {
    838:         BVSetActiveColumns(ctx->V,0,sr->sPres->nconv[0]);
    839:         BVTensorCompress(ctx->V,sr->sPres->nconv[0]);
    840:       }
    841:       for (i=0;i<sr->ndef0;i++) aux[i] = sr->idxDef0[i];
    842:       for (i=sr->ndef0;i<sr->sPres->nconv[0];i++) aux[i] = sr->indexEig+i-sr->ndef0;
    843:       BVTensorGetFactors(ctx->V,NULL,&MS);
    844:       MatDenseGetArray(MS,&S);
    845:       for (i=0;i<sr->sPres->nconv[0];i++) {
    846:         sr->eigr[aux[i]] = eigr[i];
    847:         sr->errest[aux[i]] = errest[i];
    848:         BVGetColumn(pep->V,i,&w);
    849:         BVInsertVec(sr->V,aux[i],w);
    850:         BVRestoreColumn(pep->V,i,&w);
    851:         idx = sr->ld*d*aux[i];
    852:         PetscArrayzero(sr->S+idx,sr->ld*d);
    853:         PetscArraycpy(sr->S+idx,S+i*(ld*d),sr->sPres->nconv[0]);
    854:         PetscArraycpy(sr->S+idx+sr->ld,S+i*(ld*d)+ld,sr->sPres->nconv[0]);
    855:         PetscFree(sr->qinfo[aux[i]].q);
    856:         PetscMalloc1(sr->sPres->nconv[0],&sr->qinfo[aux[i]].q);
    857:         PetscArraycpy(sr->qinfo[aux[i]].q,aux,sr->sPres->nconv[0]);
    858:         sr->qinfo[aux[i]].nq = sr->sPres->nconv[0];
    859:       }
    860:       MatDenseRestoreArray(MS,&S);
    861:       BVTensorRestoreFactors(ctx->V,NULL,&MS);
    862:     }

    864:     if (sr->sPres->nconv[1]) {
    865:       if (divide) {
    866:         BVTensorGetFactors(ctx->V,NULL,&MS);
    867:         MatDenseGetArray(MS,&S);
    868:         for (i=0;i<sr->sPres->nconv[1];i++) {
    869:           PetscArraycpy(S+i*(d*ld),tS+(sr->sPres->nconv[0]+i)*nconv*d,count);
    870:           PetscArraycpy(S+i*(d*ld)+ld,tS+(sr->sPres->nconv[0]+i)*nconv*d+nconv,count);
    871:         }
    872:         MatDenseRestoreArray(MS,&S);
    873:         BVTensorRestoreFactors(ctx->V,NULL,&MS);
    874:         BVSetActiveColumns(pep->V,0,count);
    875:         BVCopy(tV,pep->V);
    876:         BVSetActiveColumns(ctx->V,0,sr->sPres->nconv[1]);
    877:         BVTensorCompress(ctx->V,sr->sPres->nconv[1]);
    878:       }
    879:       for (i=0;i<sr->ndef1;i++) aux[i] = sr->idxDef1[i];
    880:       for (i=sr->ndef1;i<sr->sPres->nconv[1];i++) aux[i] = sr->indexEig+sr->sPres->nconv[0]-sr->ndef0+i-sr->ndef1;
    881:       BVTensorGetFactors(ctx->V,NULL,&MS);
    882:       MatDenseGetArray(MS,&S);
    883:       for (i=0;i<sr->sPres->nconv[1];i++) {
    884:         sr->eigr[aux[i]] = eigr[sr->sPres->nconv[0]+i];
    885:         sr->errest[aux[i]] = errest[sr->sPres->nconv[0]+i];
    886:         BVGetColumn(pep->V,i,&w);
    887:         BVInsertVec(sr->V,aux[i],w);
    888:         BVRestoreColumn(pep->V,i,&w);
    889:         idx = sr->ld*d*aux[i];
    890:         PetscArrayzero(sr->S+idx,sr->ld*d);
    891:         PetscArraycpy(sr->S+idx,S+i*(ld*d),sr->sPres->nconv[1]);
    892:         PetscArraycpy(sr->S+idx+sr->ld,S+i*(ld*d)+ld,sr->sPres->nconv[1]);
    893:         PetscFree(sr->qinfo[aux[i]].q);
    894:         PetscMalloc1(sr->sPres->nconv[1],&sr->qinfo[aux[i]].q);
    895:         PetscArraycpy(sr->qinfo[aux[i]].q,aux,sr->sPres->nconv[1]);
    896:         sr->qinfo[aux[i]].nq = sr->sPres->nconv[1];
    897:       }
    898:       MatDenseRestoreArray(MS,&S);
    899:       BVTensorRestoreFactors(ctx->V,NULL,&MS);
    900:     }
    901:     sPres->neigs = count-sr->ndef0-sr->ndef1;
    902:     sr->indexEig += sPres->neigs;
    903:     sPres->nconv[0]-= sr->ndef0;
    904:     sPres->nconv[1]-= sr->ndef1;
    905:     PetscFree4(eigr,errest,tS,aux);
    906:   } else {
    907:     sPres->neigs = 0;
    908:     sPres->nconv[0]= 0;
    909:     sPres->nconv[1]= 0;
    910:   }
    911:   /* Global ordering array updating */
    912:   sortRealEigenvalues(sr->eigr,sr->perm,sr->indexEig,PETSC_FALSE,sr->dir);
    913:   /* Check for completion */
    914:   sPres->comp[0] = PetscNot(sPres->nconv[0] < sPres->nsch[0]);
    915:   sPres->comp[1] = PetscNot(sPres->nconv[1] < sPres->nsch[1]);
    917:   if (divide) BVDestroy(&tV);
    918:   PetscFunctionReturn(0);
    919: }

    921: static PetscErrorCode PEPLookForDeflation(PEP pep)
    922: {
    923:   PetscReal val;
    924:   PetscInt  i,count0=0,count1=0;
    925:   PEP_shift sPres;
    926:   PetscInt  ini,fin;
    927:   PEP_SR    sr;
    928:   PEP_STOAR *ctx=(PEP_STOAR*)pep->data;

    930:   sr = ctx->sr;
    931:   sPres = sr->sPres;

    933:   if (sPres->neighb[0]) ini = (sr->dir)*(sPres->neighb[0]->inertia - sr->inertia0);
    934:   else ini = 0;
    935:   fin = sr->indexEig;
    936:   /* Selection of ends for searching new values */
    937:   if (!sPres->neighb[0]) sPres->ext[0] = sr->int0;/* First shift */
    938:   else sPres->ext[0] = sPres->neighb[0]->value;
    939:   if (!sPres->neighb[1]) {
    940:     if (sr->hasEnd) sPres->ext[1] = sr->int1;
    941:     else sPres->ext[1] = (sr->dir > 0)?PETSC_MAX_REAL:PETSC_MIN_REAL;
    942:   } else sPres->ext[1] = sPres->neighb[1]->value;
    943:   /* Selection of values between right and left ends */
    944:   for (i=ini;i<fin;i++) {
    945:     val=PetscRealPart(sr->eigr[sr->perm[i]]);
    946:     /* Values to the right of left shift */
    947:     if ((sr->dir)*(val - sPres->ext[1]) < 0) {
    948:       if ((sr->dir)*(val - sPres->value) < 0) count0++;
    949:       else count1++;
    950:     } else break;
    951:   }
    952:   /* The number of values on each side are found */
    953:   if (sPres->neighb[0]) {
    954:     sPres->nsch[0] = (sr->dir)*(sPres->inertia - sPres->neighb[0]->inertia)-count0;
    956:   } else sPres->nsch[0] = 0;

    958:   if (sPres->neighb[1]) {
    959:     sPres->nsch[1] = (sr->dir)*(sPres->neighb[1]->inertia - sPres->inertia) - count1;
    961:   } else sPres->nsch[1] = (sr->dir)*(sr->inertia1 - sPres->inertia);

    963:   /* Completing vector of indexes for deflation */
    964:   for (i=0;i<count0;i++) sr->idxDef0[i] = sr->perm[ini+i];
    965:   sr->ndef0 = count0;
    966:   for (i=0;i<count1;i++) sr->idxDef1[i] = sr->perm[ini+count0+i];
    967:   sr->ndef1 = count1;
    968:   PetscFunctionReturn(0);
    969: }

    971: /*
    972:   Compute a run of Lanczos iterations
    973: */
    974: static PetscErrorCode PEPSTOARrun_QSlice(PEP pep,PetscReal *a,PetscReal *b,PetscReal *omega,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscBool *symmlost,Vec *t_)
    975: {
    976:   PEP_STOAR      *ctx = (PEP_STOAR*)pep->data;
    977:   PetscInt       i,j,m=*M,l,lock;
    978:   PetscInt       lds,d,ld,offq,nqt,ldds;
    979:   Vec            v=t_[0],t=t_[1],q=t_[2];
    980:   PetscReal      norm,sym=0.0,fro=0.0,*f;
    981:   PetscScalar    *y,*S,sigma;
    982:   PetscBLASInt   j_,one=1;
    983:   PetscBool      lindep;
    984:   Mat            MS;

    986:   PetscMalloc1(*M,&y);
    987:   BVGetSizes(pep->V,NULL,NULL,&ld);
    988:   BVTensorGetDegree(ctx->V,&d);
    989:   BVGetActiveColumns(pep->V,&lock,&nqt);
    990:   lds = d*ld;
    991:   offq = ld;
    992:   DSGetLeadingDimension(pep->ds,&ldds);

    994:   *breakdown = PETSC_FALSE; /* ----- */
    995:   STGetShift(pep->st,&sigma);
    996:   DSGetDimensions(pep->ds,NULL,&l,NULL,NULL);
    997:   BVSetActiveColumns(ctx->V,0,m);
    998:   BVSetActiveColumns(pep->V,0,nqt);
    999:   for (j=k;j<m;j++) {
    1000:     /* apply operator */
    1001:     BVTensorGetFactors(ctx->V,NULL,&MS);
    1002:     MatDenseGetArray(MS,&S);
    1003:     BVGetColumn(pep->V,nqt,&t);
    1004:     BVMultVec(pep->V,1.0,0.0,v,S+j*lds);
    1005:     MatMult(pep->A[1],v,q);
    1006:     MatMult(pep->A[2],v,t);
    1007:     VecAXPY(q,sigma*pep->sfactor,t);
    1008:     VecScale(q,pep->sfactor);
    1009:     BVMultVec(pep->V,1.0,0.0,v,S+offq+j*lds);
    1010:     MatMult(pep->A[2],v,t);
    1011:     VecAXPY(q,pep->sfactor*pep->sfactor,t);
    1012:     STMatSolve(pep->st,q,t);
    1013:     VecScale(t,-1.0);
    1014:     BVRestoreColumn(pep->V,nqt,&t);

    1016:     /* orthogonalize */
    1017:     BVOrthogonalizeColumn(pep->V,nqt,S+(j+1)*lds,&norm,&lindep);
    1018:     if (!lindep) {
    1019:       *(S+(j+1)*lds+nqt) = norm;
    1020:       BVScaleColumn(pep->V,nqt,1.0/norm);
    1021:       nqt++;
    1022:     }
    1023:     for (i=0;i<nqt;i++) *(S+(j+1)*lds+offq+i) = *(S+j*lds+i)+sigma*(*(S+(j+1)*lds+i));
    1024:     BVSetActiveColumns(pep->V,0,nqt);
    1025:     MatDenseRestoreArray(MS,&S);
    1026:     BVTensorRestoreFactors(ctx->V,NULL,&MS);

    1028:     /* level-2 orthogonalization */
    1029:     BVOrthogonalizeColumn(ctx->V,j+1,y,&norm,&lindep);
    1030:     a[j] = PetscRealPart(y[j]);
    1031:     omega[j+1] = (norm > 0)?1.0:-1.0;
    1032:     BVScaleColumn(ctx->V,j+1,1.0/norm);
    1033:     b[j] = PetscAbsReal(norm);

    1035:     /* check symmetry */
    1036:     DSGetArrayReal(pep->ds,DS_MAT_T,&f);
    1037:     if (j==k) {
    1038:       for (i=l;i<j-1;i++) y[i] = PetscAbsScalar(y[i])-PetscAbsReal(f[2*ldds+i]);
    1039:       for (i=0;i<l;i++) y[i] = 0.0;
    1040:     }
    1041:     DSRestoreArrayReal(pep->ds,DS_MAT_T,&f);
    1042:     if (j>0) y[j-1] = PetscAbsScalar(y[j-1])-PetscAbsReal(b[j-1]);
    1043:     PetscBLASIntCast(j,&j_);
    1044:     sym = SlepcAbs(BLASnrm2_(&j_,y,&one),sym);
    1045:     fro = SlepcAbs(fro,SlepcAbs(a[j],b[j]));
    1046:     if (j>0) fro = SlepcAbs(fro,b[j-1]);
    1047:     if (sym/fro>PetscMax(PETSC_SQRT_MACHINE_EPSILON,10*pep->tol)) {
    1048:       *symmlost = PETSC_TRUE;
    1049:       *M=j;
    1050:       break;
    1051:     }
    1052:   }
    1053:   BVSetActiveColumns(pep->V,lock,nqt);
    1054:   BVSetActiveColumns(ctx->V,0,*M);
    1055:   PetscFree(y);
    1056:   PetscFunctionReturn(0);
    1057: }

    1059: static PetscErrorCode PEPSTOAR_QSlice(PEP pep,Mat B)
    1060: {
    1061:   PEP_STOAR      *ctx = (PEP_STOAR*)pep->data;
    1062:   PetscInt       j,k,l,nv=0,ld,ldds,t,nq=0,idx;
    1063:   PetscInt       nconv=0,deg=pep->nmat-1,count0=0,count1=0;
    1064:   PetscScalar    *om,sigma,*back,*S,*pQ;
    1065:   PetscReal      beta,norm=1.0,*omega,*a,*b,eta,lambda;
    1066:   PetscBool      breakdown,symmlost=PETSC_FALSE,sinv,falselock=PETSC_TRUE;
    1067:   Mat            MS,MQ;
    1068:   Vec            v,vomega;
    1069:   PEP_SR         sr;
    1070:   BVOrthogType   otype;
    1071:   BVOrthogBlockType obtype;

    1073:   /* Resize if needed for deflating vectors  */
    1074:   sr = ctx->sr;
    1075:   sigma = sr->sPres->value;
    1076:   k = sr->ndef0+sr->ndef1;
    1077:   pep->ncv = ctx->ncv+k;
    1078:   pep->nev = ctx->nev+k;
    1079:   PEPAllocateSolution(pep,3);
    1080:   BVDestroy(&ctx->V);
    1081:   BVCreateTensor(pep->V,pep->nmat-1,&ctx->V);
    1082:   BVGetOrthogonalization(pep->V,&otype,NULL,&eta,&obtype);
    1083:   BVSetOrthogonalization(ctx->V,otype,BV_ORTHOG_REFINE_ALWAYS,eta,obtype);
    1084:   DSAllocate(pep->ds,pep->ncv+2);
    1085:   PetscMalloc1(pep->ncv,&back);
    1086:   DSGetLeadingDimension(pep->ds,&ldds);
    1087:   BVSetMatrix(ctx->V,B,PETSC_TRUE);
    1089:   /* undocumented option to use a cheaper locking instead of the true locking */
    1090:   PetscOptionsGetBool(NULL,NULL,"-pep_stoar_falselocking",&falselock,NULL);
    1091:   PetscObjectTypeCompare((PetscObject)pep->st,STSINVERT,&sinv);
    1092:   RGPushScale(pep->rg,sinv?pep->sfactor:1.0/pep->sfactor);
    1093:   STScaleShift(pep->st,sinv?pep->sfactor:1.0/pep->sfactor);

    1095:   /* Get the starting Arnoldi vector */
    1096:   BVSetActiveColumns(pep->V,0,1);
    1097:   BVTensorBuildFirstColumn(ctx->V,pep->nini);
    1098:   BVSetActiveColumns(ctx->V,0,1);
    1099:   if (k) {
    1100:     /* Insert deflated vectors */
    1101:     BVSetActiveColumns(pep->V,0,0);
    1102:     idx = sr->ndef0?sr->idxDef0[0]:sr->idxDef1[0];
    1103:     for (j=0;j<k;j++) {
    1104:       BVGetColumn(pep->V,j,&v);
    1105:       BVCopyVec(sr->V,sr->qinfo[idx].q[j],v);
    1106:       BVRestoreColumn(pep->V,j,&v);
    1107:     }
    1108:     /* Update innerproduct matrix */
    1109:     BVSetActiveColumns(ctx->V,0,0);
    1110:     BVTensorGetFactors(ctx->V,NULL,&MS);
    1111:     BVSetActiveColumns(pep->V,0,k);
    1112:     BVTensorRestoreFactors(ctx->V,NULL,&MS);

    1114:     BVGetSizes(pep->V,NULL,NULL,&ld);
    1115:     BVTensorGetFactors(ctx->V,NULL,&MS);
    1116:     MatDenseGetArray(MS,&S);
    1117:     for (j=0;j<sr->ndef0;j++) {
    1118:       PetscArrayzero(S+j*ld*deg,ld*deg);
    1119:       PetscArraycpy(S+j*ld*deg,sr->S+sr->idxDef0[j]*sr->ld*deg,k);
    1120:       PetscArraycpy(S+j*ld*deg+ld,sr->S+sr->idxDef0[j]*sr->ld*deg+sr->ld,k);
    1121:       pep->eigr[j] = sr->eigr[sr->idxDef0[j]];
    1122:       pep->errest[j] = sr->errest[sr->idxDef0[j]];
    1123:     }
    1124:     for (j=0;j<sr->ndef1;j++) {
    1125:       PetscArrayzero(S+(j+sr->ndef0)*ld*deg,ld*deg);
    1126:       PetscArraycpy(S+(j+sr->ndef0)*ld*deg,sr->S+sr->idxDef1[j]*sr->ld*deg,k);
    1127:       PetscArraycpy(S+(j+sr->ndef0)*ld*deg+ld,sr->S+sr->idxDef1[j]*sr->ld*deg+sr->ld,k);
    1128:       pep->eigr[j+sr->ndef0] = sr->eigr[sr->idxDef1[j]];
    1129:       pep->errest[j+sr->ndef0] = sr->errest[sr->idxDef1[j]];
    1130:     }
    1131:     MatDenseRestoreArray(MS,&S);
    1132:     BVTensorRestoreFactors(ctx->V,NULL,&MS);
    1133:     BVSetActiveColumns(ctx->V,0,k+1);
    1134:     VecCreateSeq(PETSC_COMM_SELF,k+1,&vomega);
    1135:     VecGetArray(vomega,&om);
    1136:     for (j=0;j<k;j++) {
    1137:       BVOrthogonalizeColumn(ctx->V,j,NULL,&norm,NULL);
    1138:       BVScaleColumn(ctx->V,j,1/norm);
    1139:       om[j] = (norm>=0.0)?1.0:-1.0;
    1140:     }
    1141:     BVTensorGetFactors(ctx->V,NULL,&MS);
    1142:     MatDenseGetArray(MS,&S);
    1143:     for (j=0;j<deg;j++) {
    1144:       BVSetRandomColumn(pep->V,k+j);
    1145:       BVOrthogonalizeColumn(pep->V,k+j,S+k*ld*deg+j*ld,&norm,NULL);
    1146:       BVScaleColumn(pep->V,k+j,1.0/norm);
    1147:       S[k*ld*deg+j*ld+k+j] = norm;
    1148:     }
    1149:     MatDenseRestoreArray(MS,&S);
    1150:     BVSetActiveColumns(pep->V,0,k+deg);
    1151:     BVTensorRestoreFactors(ctx->V,NULL,&MS);
    1152:     BVOrthogonalizeColumn(ctx->V,k,NULL,&norm,NULL);
    1153:     BVScaleColumn(ctx->V,k,1.0/norm);
    1154:     om[k] = (norm>=0.0)?1.0:-1.0;
    1155:     VecRestoreArray(vomega,&om);
    1156:     BVSetSignature(ctx->V,vomega);
    1157:     DSGetArrayReal(pep->ds,DS_MAT_T,&a);
    1158:     VecGetArray(vomega,&om);
    1159:     for (j=0;j<k;j++) a[j] = PetscRealPart(om[j]/(pep->eigr[j]-sigma));
    1160:     VecRestoreArray(vomega,&om);
    1161:     VecDestroy(&vomega);
    1162:     DSRestoreArrayReal(pep->ds,DS_MAT_T,&a);
    1163:     DSGetArray(pep->ds,DS_MAT_Q,&pQ);
    1164:     PetscArrayzero(pQ,ldds*k);
    1165:     for (j=0;j<k;j++) pQ[j+j*ldds] = 1.0;
    1166:     DSRestoreArray(pep->ds,DS_MAT_Q,&pQ);
    1167:   }
    1168:   BVSetActiveColumns(ctx->V,0,k+1);
    1169:   DSGetArrayReal(pep->ds,DS_MAT_D,&omega);
    1170:   VecCreateSeq(PETSC_COMM_SELF,k+1,&vomega);
    1171:   BVGetSignature(ctx->V,vomega);
    1172:   VecGetArray(vomega,&om);
    1173:   for (j=0;j<k+1;j++) omega[j] = PetscRealPart(om[j]);
    1174:   VecRestoreArray(vomega,&om);
    1175:   DSRestoreArrayReal(pep->ds,DS_MAT_D,&omega);
    1176:   VecDestroy(&vomega);

    1178:   PetscInfo(pep,"Start STOAR: sigma=%g in [%g,%g], for deflation: left=%" PetscInt_FMT " right=%" PetscInt_FMT ", searching: left=%" PetscInt_FMT " right=%" PetscInt_FMT "\n",(double)sr->sPres->value,(double)(sr->sPres->neighb[0]?sr->sPres->neighb[0]->value:sr->int0),(double)(sr->sPres->neighb[1]?sr->sPres->neighb[1]->value:sr->int1),sr->ndef0,sr->ndef1,sr->sPres->nsch[0],sr->sPres->nsch[1]);

    1180:   /* Restart loop */
    1181:   l = 0;
    1182:   pep->nconv = k;
    1183:   while (pep->reason == PEP_CONVERGED_ITERATING) {
    1184:     pep->its++;
    1185:     DSGetArrayReal(pep->ds,DS_MAT_T,&a);
    1186:     b = a+ldds;
    1187:     DSGetArrayReal(pep->ds,DS_MAT_D,&omega);

    1189:     /* Compute an nv-step Lanczos factorization */
    1190:     nv = PetscMin(pep->nconv+pep->mpd,pep->ncv);
    1191:     PEPSTOARrun_QSlice(pep,a,b,omega,pep->nconv+l,&nv,&breakdown,&symmlost,pep->work);
    1192:     beta = b[nv-1];
    1193:     if (symmlost && nv==pep->nconv+l) {
    1194:       pep->reason = PEP_DIVERGED_SYMMETRY_LOST;
    1195:       pep->nconv = nconv;
    1196:       PetscInfo(pep,"Symmetry lost in STOAR sigma=%g nconv=%" PetscInt_FMT "\n",(double)sr->sPres->value,nconv);
    1197:       if (falselock || !ctx->lock) {
    1198:         BVSetActiveColumns(ctx->V,0,pep->nconv);
    1199:         BVTensorCompress(ctx->V,0);
    1200:       }
    1201:       break;
    1202:     }
    1203:     DSRestoreArrayReal(pep->ds,DS_MAT_T,&a);
    1204:     DSRestoreArrayReal(pep->ds,DS_MAT_D,&omega);
    1205:     DSSetDimensions(pep->ds,nv,pep->nconv,pep->nconv+l);
    1206:     if (l==0) DSSetState(pep->ds,DS_STATE_INTERMEDIATE);
    1207:     else DSSetState(pep->ds,DS_STATE_RAW);

    1209:     /* Solve projected problem */
    1210:     DSSolve(pep->ds,pep->eigr,pep->eigi);
    1211:     DSSort(pep->ds,pep->eigr,pep->eigi,NULL,NULL,NULL);
    1212:     DSUpdateExtraRow(pep->ds);
    1213:     DSSynchronize(pep->ds,pep->eigr,pep->eigi);

    1215:     /* Check convergence */
    1216:     /* PEPSTOARpreKConvergence(pep,nv,&norm,pep->work);*/
    1217:     norm = 1.0;
    1218:     DSGetDimensions(pep->ds,NULL,NULL,NULL,&t);
    1219:     PEPKrylovConvergence(pep,PETSC_FALSE,pep->nconv,t-pep->nconv,PetscAbsReal(beta)*norm,&k);
    1220:     (*pep->stopping)(pep,pep->its,pep->max_it,k,pep->nev,&pep->reason,pep->stoppingctx);
    1221:     for (j=0;j<k;j++) back[j] = pep->eigr[j];
    1222:     STBackTransform(pep->st,k,back,pep->eigi);
    1223:     count0=count1=0;
    1224:     for (j=0;j<k;j++) {
    1225:       lambda = PetscRealPart(back[j]);
    1226:       if (((sr->dir)*(sr->sPres->value - lambda) > 0) && ((sr->dir)*(lambda - sr->sPres->ext[0]) > 0)) count0++;
    1227:       if (((sr->dir)*(lambda - sr->sPres->value) > 0) && ((sr->dir)*(sr->sPres->ext[1] - lambda) > 0)) count1++;
    1228:     }
    1229:     if ((count0-sr->ndef0 >= sr->sPres->nsch[0]) && (count1-sr->ndef1 >= sr->sPres->nsch[1])) pep->reason = PEP_CONVERGED_TOL;
    1230:     /* Update l */
    1231:     if (pep->reason != PEP_CONVERGED_ITERATING || breakdown) l = 0;
    1232:     else {
    1233:       l = PetscMax(1,(PetscInt)((nv-k)/2));
    1234:       l = PetscMin(l,t);
    1235:       DSGetTruncateSize(pep->ds,k,t,&l);
    1236:       if (!breakdown) {
    1237:         /* Prepare the Rayleigh quotient for restart */
    1238:         DSTruncate(pep->ds,k+l,PETSC_FALSE);
    1239:       }
    1240:     }
    1241:     nconv = k;
    1242:     if (!ctx->lock && pep->reason == PEP_CONVERGED_ITERATING && !breakdown) { l += k; k = 0; } /* non-locking variant: reset no. of converged pairs */
    1243:     if (l) PetscInfo(pep,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l);

    1245:     /* Update S */
    1246:     DSGetMat(pep->ds,DS_MAT_Q,&MQ);
    1247:     BVMultInPlace(ctx->V,MQ,pep->nconv,k+l);
    1248:     MatDestroy(&MQ);

    1250:     /* Copy last column of S */
    1251:     BVCopyColumn(ctx->V,nv,k+l);
    1252:     DSGetArrayReal(pep->ds,DS_MAT_D,&omega);
    1253:     VecCreateSeq(PETSC_COMM_SELF,k+l,&vomega);
    1254:     VecGetArray(vomega,&om);
    1255:     for (j=0;j<k+l;j++) om[j] = omega[j];
    1256:     VecRestoreArray(vomega,&om);
    1257:     BVSetActiveColumns(ctx->V,0,k+l);
    1258:     BVSetSignature(ctx->V,vomega);
    1259:     VecDestroy(&vomega);
    1260:     DSRestoreArrayReal(pep->ds,DS_MAT_D,&omega);

    1262:     if (breakdown && pep->reason == PEP_CONVERGED_ITERATING) {
    1263:       /* stop if breakdown */
    1264:       PetscInfo(pep,"Breakdown TOAR method (it=%" PetscInt_FMT " norm=%g)\n",pep->its,(double)beta);
    1265:       pep->reason = PEP_DIVERGED_BREAKDOWN;
    1266:     }
    1267:     if (pep->reason != PEP_CONVERGED_ITERATING) l--;
    1268:     BVGetActiveColumns(pep->V,NULL,&nq);
    1269:     if (k+l+deg<=nq) {
    1270:       BVSetActiveColumns(ctx->V,pep->nconv,k+l+1);
    1271:       if (!falselock && ctx->lock) BVTensorCompress(ctx->V,k-pep->nconv);
    1272:       else BVTensorCompress(ctx->V,0);
    1273:     }
    1274:     pep->nconv = k;
    1275:     PEPMonitor(pep,pep->its,nconv,pep->eigr,pep->eigi,pep->errest,nv);
    1276:   }
    1277:   sr->itsKs += pep->its;
    1278:   if (pep->nconv>0) {
    1279:     BVSetActiveColumns(ctx->V,0,pep->nconv);
    1280:     BVGetActiveColumns(pep->V,NULL,&nq);
    1281:     BVSetActiveColumns(pep->V,0,nq);
    1282:     if (nq>pep->nconv) {
    1283:       BVTensorCompress(ctx->V,pep->nconv);
    1284:       BVSetActiveColumns(pep->V,0,pep->nconv);
    1285:     }
    1286:     for (j=0;j<pep->nconv;j++) {
    1287:       pep->eigr[j] *= pep->sfactor;
    1288:       pep->eigi[j] *= pep->sfactor;
    1289:     }
    1290:   }
    1291:   PetscInfo(pep,"Finished STOAR: nconv=%" PetscInt_FMT " (deflated=%" PetscInt_FMT ", left=%" PetscInt_FMT ", right=%" PetscInt_FMT ")\n",pep->nconv,sr->ndef0+sr->ndef1,count0-sr->ndef0,count1-sr->ndef1);
    1292:   STScaleShift(pep->st,sinv?1.0/pep->sfactor:pep->sfactor);
    1293:   RGPopScale(pep->rg);

    1296:   if (pep->reason == PEP_DIVERGED_SYMMETRY_LOST && nconv==sr->ndef0+sr->ndef1) {
    1298:   } else sr->symmlost = 0;

    1300:   DSTruncate(pep->ds,pep->nconv,PETSC_TRUE);
    1301:   PetscFree(back);
    1302:   PetscFunctionReturn(0);
    1303: }

    1305: #define SWAP(a,b,t) {t=a;a=b;b=t;}

    1307: static PetscErrorCode PEPQSliceGetInertias(PEP pep,PetscInt *n,PetscReal **shifts,PetscInt **inertias)
    1308: {
    1309:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    1310:   PEP_SR          sr=ctx->sr;
    1311:   PetscInt        i=0,j,tmpi;
    1312:   PetscReal       v,tmpr;
    1313:   PEP_shift       s;

    1317:   if (!sr->s0) {  /* PEPSolve not called yet */
    1318:     *n = 2;
    1319:   } else {
    1320:     *n = 1;
    1321:     s = sr->s0;
    1322:     while (s) {
    1323:       (*n)++;
    1324:       s = s->neighb[1];
    1325:     }
    1326:   }
    1327:   PetscMalloc1(*n,shifts);
    1328:   PetscMalloc1(*n,inertias);
    1329:   if (!sr->s0) {  /* PEPSolve not called yet */
    1330:     (*shifts)[0]   = sr->int0;
    1331:     (*shifts)[1]   = sr->int1;
    1332:     (*inertias)[0] = sr->inertia0;
    1333:     (*inertias)[1] = sr->inertia1;
    1334:   } else {
    1335:     s = sr->s0;
    1336:     while (s) {
    1337:       (*shifts)[i]     = s->value;
    1338:       (*inertias)[i++] = s->inertia;
    1339:       s = s->neighb[1];
    1340:     }
    1341:     (*shifts)[i]   = sr->int1;
    1342:     (*inertias)[i] = sr->inertia1;
    1343:   }
    1344:   /* remove possible duplicate in last position */
    1345:   if ((*shifts)[(*n)-1]==(*shifts)[(*n)-2]) (*n)--;
    1346:   /* sort result */
    1347:   for (i=0;i<*n;i++) {
    1348:     v = (*shifts)[i];
    1349:     for (j=i+1;j<*n;j++) {
    1350:       if (v > (*shifts)[j]) {
    1351:         SWAP((*shifts)[i],(*shifts)[j],tmpr);
    1352:         SWAP((*inertias)[i],(*inertias)[j],tmpi);
    1353:         v = (*shifts)[i];
    1354:       }
    1355:     }
    1356:   }
    1357:   PetscFunctionReturn(0);
    1358: }

    1360: PetscErrorCode PEPSolve_STOAR_QSlice(PEP pep)
    1361: {
    1362:   PetscInt       i,j,ti,deg=pep->nmat-1;
    1363:   PetscReal      newS;
    1364:   PEP_STOAR      *ctx=(PEP_STOAR*)pep->data;
    1365:   PEP_SR         sr=ctx->sr;
    1366:   Mat            S,B;
    1367:   PetscScalar    *pS;

    1369:   PetscCitationsRegister(citation,&cited);

    1371:   /* Only with eigenvalues present in the interval ...*/
    1372:   if (sr->numEigs==0) {
    1373:     pep->reason = PEP_CONVERGED_TOL;
    1374:     PetscFunctionReturn(0);
    1375:   }

    1377:   /* Inner product matrix */
    1378:   PEPSTOARSetUpInnerMatrix(pep,&B);

    1380:   /* Array of pending shifts */
    1381:   sr->maxPend = 100; /* Initial size */
    1382:   sr->nPend = 0;
    1383:   PetscMalloc1(sr->maxPend,&sr->pending);
    1384:   PetscLogObjectMemory((PetscObject)pep,sr->maxPend*sizeof(PEP_shift*));
    1385:   PEPCreateShift(pep,sr->int0,NULL,NULL);
    1386:   /* extract first shift */
    1387:   sr->sPrev = NULL;
    1388:   sr->sPres = sr->pending[--sr->nPend];
    1389:   sr->sPres->inertia = sr->inertia0;
    1390:   pep->target = sr->sPres->value;
    1391:   sr->s0 = sr->sPres;
    1392:   sr->indexEig = 0;

    1394:   for (i=0;i<sr->numEigs;i++) {
    1395:     sr->eigr[i]   = 0.0;
    1396:     sr->eigi[i]   = 0.0;
    1397:     sr->errest[i] = 0.0;
    1398:     sr->perm[i]   = i;
    1399:   }
    1400:   /* Vectors for deflation */
    1401:   PetscMalloc2(sr->numEigs,&sr->idxDef0,sr->numEigs,&sr->idxDef1);
    1402:   PetscLogObjectMemory((PetscObject)pep,2*sr->numEigs*sizeof(PetscInt));
    1403:   sr->indexEig = 0;
    1404:   while (sr->sPres) {
    1405:     /* Search for deflation */
    1406:     PEPLookForDeflation(pep);
    1407:     /* KrylovSchur */
    1408:     PEPSTOAR_QSlice(pep,B);

    1410:     PEPStoreEigenpairs(pep);
    1411:     /* Select new shift */
    1412:     if (!sr->sPres->comp[1]) {
    1413:       PEPGetNewShiftValue(pep,1,&newS);
    1414:       PEPCreateShift(pep,newS,sr->sPres,sr->sPres->neighb[1]);
    1415:     }
    1416:     if (!sr->sPres->comp[0]) {
    1417:       /* Completing earlier interval */
    1418:       PEPGetNewShiftValue(pep,0,&newS);
    1419:       PEPCreateShift(pep,newS,sr->sPres->neighb[0],sr->sPres);
    1420:     }
    1421:     /* Preparing for a new search of values */
    1422:     PEPExtractShift(pep);
    1423:   }

    1425:   /* Updating pep values prior to exit */
    1426:   PetscFree2(sr->idxDef0,sr->idxDef1);
    1427:   PetscFree(sr->pending);
    1428:   pep->nconv  = sr->indexEig;
    1429:   pep->reason = PEP_CONVERGED_TOL;
    1430:   pep->its    = sr->itsKs;
    1431:   pep->nev    = sr->indexEig;
    1432:   MatCreateSeqDense(PETSC_COMM_SELF,pep->nconv,pep->nconv,NULL,&S);
    1433:   MatDenseGetArray(S,&pS);
    1434:   for (i=0;i<pep->nconv;i++) {
    1435:     for (j=0;j<sr->qinfo[i].nq;j++) pS[i*pep->nconv+sr->qinfo[i].q[j]] = *(sr->S+i*sr->ld*deg+j);
    1436:   }
    1437:   MatDenseRestoreArray(S,&pS);
    1438:   BVSetActiveColumns(sr->V,0,pep->nconv);
    1439:   BVMultInPlace(sr->V,S,0,pep->nconv);
    1440:   MatDestroy(&S);
    1441:   BVDestroy(&pep->V);
    1442:   pep->V = sr->V;
    1443:   PetscFree4(pep->eigr,pep->eigi,pep->errest,pep->perm);
    1444:   pep->eigr   = sr->eigr;
    1445:   pep->eigi   = sr->eigi;
    1446:   pep->perm   = sr->perm;
    1447:   pep->errest = sr->errest;
    1448:   if (sr->dir<0) {
    1449:     for (i=0;i<pep->nconv/2;i++) {
    1450:       ti = sr->perm[i]; sr->perm[i] = sr->perm[pep->nconv-1-i]; sr->perm[pep->nconv-1-i] = ti;
    1451:     }
    1452:   }
    1453:   PetscFree(ctx->inertias);
    1454:   PetscFree(ctx->shifts);
    1455:   MatDestroy(&B);
    1456:   PEPQSliceGetInertias(pep,&ctx->nshifts,&ctx->shifts,&ctx->inertias);
    1457:   PetscFunctionReturn(0);
    1458: }