Actual source code: ks-bse.c

      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 eigensolver: "krylovschur"

     13:    Method: thick-restarted Lanczos for Bethe-Salpeter pseudo-Hermitan matrices

     15:    References:

     17:        [1] M. Shao et al, "A structure preserving Lanczos algorithm for computing
     18:            the optical absorption spectrum", SIAM J. Matrix Anal. App. 39(2), 2018.

     20:        [2] F. Alvarruiz, B. Mellado-Pinto, J. E. Roman, "Variants of thick-restart
     21:            Lanczos for the Bethe-Salpeter eigenvalue problem", arXiv:2503.20920,
     22:            2025.

     24: */
     25: #include <slepc/private/epsimpl.h>
     26: #include "krylovschur.h"

     28: static PetscBool  cited = PETSC_FALSE;
     29: static const char citation[] =
     30:   "@Misc{slepc-bse,\n"
     31:   "   author = \"F. Alvarruiz and B. Mellado-Pinto and J. E. Roman\",\n"
     32:   "   title = \"Variants of thick-restart {Lanczos} for the {Bethe--Salpeter} eigenvalue problem\",\n"
     33:   "   eprint = \"2503.20920\",\n"
     34:   "   archivePrefix = \"arXiv\",\n"
     35:   "   primaryClass = \"mathematics.numerical analysis\",\n"
     36:   "   year = \"2025,\"\n"
     37:   "   doi = \"https://doi.org/10.48550/arXiv.2503.20920\"\n"
     38:   "}\n";

     40: static PetscErrorCode Orthog_Shao(Vec x,BV U,BV V,PetscInt j,PetscScalar *h,PetscScalar *c,PetscBool *breakdown)
     41: {
     42:   PetscInt i;

     44:   PetscFunctionBegin;
     45:   PetscCall(BVSetActiveColumns(U,0,j));
     46:   PetscCall(BVSetActiveColumns(V,0,j));
     47:   /* c = real(V^* x) ; c2 = imag(U^* x)*1i */
     48: #if defined(PETSC_USE_COMPLEX)
     49:   PetscCall(BVDotVecBegin(V,x,c));
     50:   PetscCall(BVDotVecBegin(U,x,c+j));
     51:   PetscCall(BVDotVecEnd(V,x,c));
     52:   PetscCall(BVDotVecEnd(U,x,c+j));
     53: #else
     54:   PetscCall(BVDotVec(V,x,c));
     55: #endif
     56: #if defined(PETSC_USE_COMPLEX)
     57:   for (i=0; i<j; i++) {
     58:     c[i] = PetscRealPart(c[i]);
     59:     c[j+i] = PetscCMPLX(0.0,PetscImaginaryPart(c[j+i]));
     60:   }
     61: #endif
     62:   /* x = x-U*c-V*c2 */
     63:   PetscCall(BVMultVec(U,-1.0,1.0,x,c));
     64: #if defined(PETSC_USE_COMPLEX)
     65:   PetscCall(BVMultVec(V,-1.0,1.0,x,c+j));
     66: #endif
     67:   /* accumulate orthog coeffs into h */
     68:   for (i=0; i<2*j; i++) h[i] += c[i];
     69:   PetscFunctionReturn(PETSC_SUCCESS);
     70: }

     72: /* Orthogonalize vector x against first j vectors in U and V
     73: v is column j-1 of V */
     74: static PetscErrorCode OrthogonalizeVector_Shao(Vec x,BV U,BV V,PetscInt j,Vec v,PetscReal *beta,PetscInt k,PetscScalar *h,PetscBool *breakdown)
     75: {
     76:   PetscReal alpha;
     77:   PetscInt  i,l;

     79:   PetscFunctionBegin;
     80:   PetscCall(PetscArrayzero(h,2*j));

     82:   /* Local orthogonalization */
     83:   l = j==k+1?0:j-2;  /* 1st column to orthogonalize against */
     84:   PetscCall(VecDotRealPart(x,v,&alpha));
     85:   for (i=l; i<j-1; i++) h[i] = beta[i];
     86:   h[j-1] = alpha;
     87:   /* x = x-U(:,l:j-1)*h(l:j-1) */
     88:   PetscCall(BVSetActiveColumns(U,l,j));
     89:   PetscCall(BVMultVec(U,-1.0,1.0,x,h+l));

     91:   /* Full orthogonalization */
     92:   PetscCall(Orthog_Shao(x,U,V,j,h,h+2*j,breakdown));
     93:   PetscFunctionReturn(PETSC_SUCCESS);
     94: }

     96: static PetscErrorCode EPSBSELanczos_Shao(EPS eps,BV U,BV V,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown)
     97: {
     98:   PetscInt       j,m = *M;
     99:   Vec            v,x,y,w,f,g,vecs[2];
    100:   Mat            H;
    101:   IS             is[2];
    102:   PetscReal      nrm;
    103:   PetscScalar    *hwork,lhwork[100],gamma;
    104:   PetscContainer container;
    105:   SlepcMatStruct mctx;

    107:   PetscFunctionBegin;
    108:   if (4*m > 100) PetscCall(PetscMalloc1(4*m,&hwork));
    109:   else hwork = lhwork;
    110:   PetscCall(STGetMatrix(eps->st,0,&H));
    111:   PetscCall(MatNestGetISs(H,is,NULL));
    112:   PetscCall(PetscObjectQuery((PetscObject)H,"SlepcMatStruct",(PetscObject*)&container));
    113:   PetscCall(PetscContainerGetPointer(container,(void**)&mctx));

    115:   /* create work vectors */
    116:   PetscCall(BVGetColumn(V,0,&v));
    117:   PetscCall(VecDuplicate(v,&w));
    118:   vecs[0] = v;
    119:   vecs[1] = w;
    120:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&f));
    121:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&g));
    122:   PetscCall(BVRestoreColumn(V,0,&v));

    124:   /* Normalize initial vector */
    125:   if (k==0) {
    126:     if (eps->nini==0) PetscCall(BVSetRandomColumn(eps->V,0));
    127:     PetscCall(BVGetColumn(U,0,&x));
    128:     PetscCall(BVGetColumn(V,0,&y));
    129:     PetscCall(VecNestSetSubVec(f,0,x));
    130:     PetscCall(VecNestSetSubVec(g,0,y));
    131:     mctx->s = 1.0;
    132:     PetscCall(STApply(eps->st,f,g));
    133:     PetscCall(VecDot(y,x,&gamma));
    134:     nrm = PetscSqrtReal(PetscRealPart(gamma));
    135:     PetscCall(VecScale(x,1.0/nrm));
    136:     PetscCall(VecScale(y,1.0/nrm));
    137:     PetscCall(BVRestoreColumn(U,0,&x));
    138:     PetscCall(BVRestoreColumn(V,0,&y));
    139:   }

    141:   for (j=k;j<m;j++) {
    142:     /* j+1 columns (indexes 0 to j) have been computed */
    143:     PetscCall(BVGetColumn(V,j,&v));
    144:     PetscCall(BVGetColumn(U,j+1,&x));
    145:     PetscCall(BVGetColumn(V,j+1,&y));
    146:     PetscCall(VecNestSetSubVec(f,0,v));
    147:     PetscCall(VecNestSetSubVec(g,0,x));
    148:     mctx->s = -1.0;
    149:     PetscCall(STApply(eps->st,f,g));
    150:     PetscCall(OrthogonalizeVector_Shao(x,U,V,j+1,v,beta,k,hwork,breakdown));
    151:     alpha[j] = PetscRealPart(hwork[j]);
    152:     PetscCall(VecNestSetSubVec(f,0,x));
    153:     PetscCall(VecNestSetSubVec(g,0,y));
    154:     mctx->s = 1.0;
    155:     PetscCall(STApply(eps->st,f,g));
    156:     PetscCall(VecDot(x,y,&gamma));
    157:     beta[j] = PetscSqrtReal(PetscRealPart(gamma));
    158:     PetscCall(VecScale(x,1.0/beta[j]));
    159:     PetscCall(VecScale(y,1.0/beta[j]));
    160:     PetscCall(BVRestoreColumn(V,j,&v));
    161:     PetscCall(BVRestoreColumn(U,j+1,&x));
    162:     PetscCall(BVRestoreColumn(V,j+1,&y));
    163:   }
    164:   if (4*m > 100) PetscCall(PetscFree(hwork));
    165:   PetscCall(VecDestroy(&w));
    166:   PetscCall(VecDestroy(&f));
    167:   PetscCall(VecDestroy(&g));
    168:   PetscFunctionReturn(PETSC_SUCCESS);
    169: }

    171: static PetscErrorCode EPSComputeVectors_BSE_Shao(EPS eps)
    172: {
    173:   Mat         H;
    174:   Vec         u1,v1;
    175:   BV          U,V;
    176:   IS          is[2];
    177:   PetscInt    k;
    178:   PetscScalar lambda;

    180:   PetscFunctionBegin;
    181:   PetscCall(STGetMatrix(eps->st,0,&H));
    182:   PetscCall(MatNestGetISs(H,is,NULL));
    183:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));
    184:   for (k=0; k<eps->nconv; k++) {
    185:     PetscCall(BVGetColumn(U,k,&u1));
    186:     PetscCall(BVGetColumn(V,k,&v1));
    187:     /* approx eigenvector is [    (eigr[k]*u1+v1)]
    188:                              [conj(eigr[k]*u1-v1)]  */
    189:     lambda = eps->eigr[k];
    190:     PetscCall(STBackTransform(eps->st,1,&lambda,&eps->eigi[k]));
    191:     PetscCall(VecAYPX(u1,lambda,v1));
    192:     PetscCall(VecAYPX(v1,-2.0,u1));
    193:     PetscCall(VecConjugate(v1));
    194:     PetscCall(BVRestoreColumn(U,k,&u1));
    195:     PetscCall(BVRestoreColumn(V,k,&v1));
    196:   }
    197:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    198:   /* Normalize eigenvectors */
    199:   PetscCall(BVSetActiveColumns(eps->V,0,eps->nconv));
    200:   PetscCall(BVNormalize(eps->V,NULL));
    201:   PetscFunctionReturn(PETSC_SUCCESS);
    202: }

    204: static PetscErrorCode Orthog_Gruning(Vec x,BV U,BV V,BV HU,BV HV,PetscInt j,PetscScalar *h,PetscScalar *c,PetscBool *breakdown)
    205: {
    206:   PetscInt i;

    208:   PetscFunctionBegin;
    209:   PetscCall(BVSetActiveColumns(U,0,j));
    210:   PetscCall(BVSetActiveColumns(HU,0,j));
    211:   PetscCall(BVSetActiveColumns(V,0,j));
    212:   PetscCall(BVSetActiveColumns(HV,0,j));
    213: #if defined(PETSC_USE_COMPLEX)
    214:   PetscCall(BVDotVecBegin(HU,x,c));
    215:   PetscCall(BVDotVecBegin(HV,x,c+j));
    216:   PetscCall(BVDotVecEnd(HU,x,c));
    217:   PetscCall(BVDotVecEnd(HV,x,c+j));
    218: #else
    219:   PetscCall(BVDotVec(HU,x,c));
    220: #endif
    221:   for (i=0; i<j; i++) {
    222:     /* c1 = 2*real(HU^* x) ; c2 = 2*imag(HV^* x)*1i */
    223: #if defined(PETSC_USE_COMPLEX)
    224:     c[i] = PetscRealPart(c[i]);
    225:     c[j+i] = PetscCMPLX(0.0,PetscImaginaryPart(c[j+i]));
    226: #else
    227:     c[j+i] = 0.0;
    228: #endif
    229:   }
    230:   /* x = x-U*c1-V*c2 */
    231: #if defined(PETSC_USE_COMPLEX)
    232:   PetscCall(BVMultVec(U,-2.0,1.0,x,c));
    233:   PetscCall(BVMultVec(V,-2.0,1.0,x,c+j));
    234: #else
    235:   PetscCall(BVMultVec(U,-2.0,1.0,x,c));
    236: #endif
    237:   /* accumulate orthog coeffs into h */
    238:   for (i=0; i<2*j; i++) h[i] += 2*c[i];
    239:   PetscFunctionReturn(PETSC_SUCCESS);
    240: }

    242: /* Orthogonalize vector x against first j vectors in U and V */
    243: static PetscErrorCode OrthogonalizeVector_Gruning(Vec x,BV U,BV V,BV HU,BV HV,PetscInt j,PetscReal *beta,PetscInt k,PetscScalar *h,PetscBool s,PetscBool *breakdown)
    244: {
    245:   PetscInt l,i;
    246:   Vec      u;

    248:   PetscFunctionBegin;
    249:   PetscCall(PetscArrayzero(h,4*j));

    251:   if (s) {
    252:     /* Local orthogonalization */
    253:     PetscCall(BVGetColumn(U,j-1,&u));
    254:     PetscCall(VecAXPY(x,-*beta,u));
    255:     PetscCall(BVRestoreColumn(U,j-1,&u));
    256:     h[j-1] = *beta;
    257:     /* Full orthogonalization */
    258:     PetscCall(Orthog_Gruning(x,U,V,HU,HV,j,h,h+2*j,breakdown));
    259:   } else {
    260:     /* Local orthogonalization */
    261:     l = j==k+1?0:j-2;  /* 1st column to orthogonalize against */
    262:     for (i=l; i<j-1; i++) h[j+i] = beta[i];
    263:     /* x = x-V(:,l:j-2)*h(l:j-2) */
    264:     PetscCall(BVSetActiveColumns(V,l,j-1));
    265:     PetscCall(BVMultVec(V,-1.0,1.0,x,h+j+l));
    266:   }
    267:   PetscFunctionReturn(PETSC_SUCCESS);
    268: }

    270: static PetscErrorCode EPSBSELanczos_Gruning(EPS eps,BV U,BV V,BV HU,BV HV,PetscReal *beta1,PetscReal *beta2,PetscInt k,PetscInt *M,PetscBool *breakdown)
    271: {
    272:   PetscInt       j,m = *M;
    273:   Vec            v,x,y,w,f,g,vecs[2];
    274:   Mat            H;
    275:   IS             is[2];
    276:   PetscReal      nrm;
    277:   PetscScalar    *hwork,lhwork[100],dot;
    278:   PetscContainer container;
    279:   SlepcMatStruct mctx;

    281:   PetscFunctionBegin;
    282:   if (4*m > 100) PetscCall(PetscMalloc1(4*m,&hwork));
    283:   else hwork = lhwork;
    284:   PetscCall(STGetMatrix(eps->st,0,&H));
    285:   PetscCall(MatNestGetISs(H,is,NULL));
    286:   PetscCall(PetscObjectQuery((PetscObject)H,"SlepcMatStruct",(PetscObject*)&container));
    287:   PetscCall(PetscContainerGetPointer(container,(void**)&mctx));

    289:   /* create work vectors */
    290:   PetscCall(BVGetColumn(V,0,&v));
    291:   PetscCall(VecDuplicate(v,&w));
    292:   vecs[0] = v;
    293:   vecs[1] = w;
    294:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&f));
    295:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&g));
    296:   PetscCall(BVRestoreColumn(V,0,&v));

    298:   /* Normalize initial vector */
    299:   if (k==0) {
    300:     if (eps->nini==0) PetscCall(BVSetRandomColumn(eps->V,0));
    301:     /* y = Hmult(v1,1) */
    302:     PetscCall(BVGetColumn(U,k,&x));
    303:     PetscCall(BVGetColumn(HU,k,&y));
    304:     PetscCall(VecNestSetSubVec(f,0,x));
    305:     PetscCall(VecNestSetSubVec(g,0,y));
    306:     mctx->s = 1.0;
    307:     PetscCall(STApply(eps->st,f,g));
    308:     /* nrm = sqrt(2*real(u1'*y)); */
    309:     PetscCall(VecDot(x,y,&dot));
    310:     nrm = PetscSqrtReal(PetscRealPart(2*dot));
    311:     /* U(:,j) = u1/nrm; */
    312:     /* HU(:,j) = y/nrm; */
    313:     PetscCall(VecScale(x,1.0/nrm));
    314:     PetscCall(VecScale(y,1.0/nrm));
    315:     PetscCall(BVRestoreColumn(U,k,&x));
    316:     PetscCall(BVRestoreColumn(HU,k,&y));
    317:   }

    319:   for (j=k;j<m;j++) {
    320:     /* j+1 columns (indexes 0 to j) have been computed */
    321:     PetscCall(BVGetColumn(HU,j,&x));
    322:     PetscCall(BVGetColumn(V,j,&v));
    323:     PetscCall(BVGetColumn(HV,j,&y));
    324:     PetscCall(VecCopy(x,v));
    325:     PetscCall(BVRestoreColumn(HU,j,&x));
    326:     /* v = Orthogonalize HU(:,j) */
    327:     PetscCall(OrthogonalizeVector_Gruning(v,U,V,HU,HV,j+1,beta2,k,hwork,PETSC_FALSE,breakdown));
    328:     /* y = Hmult(v,-1) */
    329:     PetscCall(VecNestSetSubVec(f,0,v));
    330:     PetscCall(VecNestSetSubVec(g,0,y));
    331:     mctx->s = -1.0;
    332:     PetscCall(STApply(eps->st,f,g));
    333:     /* beta = sqrt(2*real(v'*y)); */
    334:     PetscCall(VecDot(v,y,&dot));
    335:     beta1[j] = PetscSqrtReal(PetscRealPart(2*dot)); //FIXME Check beta != 0?
    336:     /* V(:,j) = v/beta1; */
    337:     /* HV(:,j) = y/beta1; */
    338:     PetscCall(VecScale(v,1.0/beta1[j]));
    339:     PetscCall(VecScale(y,1.0/beta1[j]));
    340:     PetscCall(BVRestoreColumn(V,j,&v));
    341:     PetscCall(BVRestoreColumn(HV,j,&y));

    343:     PetscCall(BVGetColumn(HV,j,&x));
    344:     PetscCall(BVGetColumn(U,j+1,&v));
    345:     PetscCall(BVGetColumn(HU,j+1,&y));
    346:     PetscCall(VecCopy(x,v));
    347:     PetscCall(BVRestoreColumn(HV,j,&x));
    348:     /* v = Orthogonalize HV(:,j) */
    349:     PetscCall(OrthogonalizeVector_Gruning(v,U,V,HU,HV,j+1,&beta1[j],k,hwork,PETSC_TRUE,breakdown));
    350:     /* y = Hmult(v,1) */
    351:     PetscCall(VecNestSetSubVec(f,0,v));
    352:     PetscCall(VecNestSetSubVec(g,0,y));
    353:     mctx->s = 1.0;
    354:     PetscCall(STApply(eps->st,f,g));
    355:     /* beta = sqrt(2*real(v'*y)); */
    356:     PetscCall(VecDot(v,y,&dot));
    357:     beta2[j] = PetscSqrtReal(PetscRealPart(2*dot)); //FIXME Check beta != 0?
    358:     /* U(:,j) = v/beta2; */
    359:     /* HU(:,j) = y/beta2; */
    360:     PetscCall(VecScale(v,1.0/beta2[j]));
    361:     PetscCall(VecScale(y,1.0/beta2[j]));
    362:     PetscCall(BVRestoreColumn(U,j+1,&v));
    363:     PetscCall(BVRestoreColumn(HU,j+1,&y));
    364:   }
    365:   if (4*m > 100) PetscCall(PetscFree(hwork));
    366:   PetscCall(VecDestroy(&w));
    367:   PetscCall(VecDestroy(&f));
    368:   PetscCall(VecDestroy(&g));
    369:   PetscFunctionReturn(PETSC_SUCCESS);
    370: }

    372: static PetscErrorCode EPSComputeVectors_BSE_Gruning(EPS eps)
    373: {
    374:   Mat         H;
    375:   Vec         u1,v1;
    376:   BV          U,V;
    377:   IS          is[2];
    378:   PetscInt    k;

    380:   PetscFunctionBegin;
    381:   PetscCall(STGetMatrix(eps->st,0,&H));
    382:   PetscCall(MatNestGetISs(H,is,NULL));
    383:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));
    384:   /* approx eigenvector [x1] is [     u1+v1       ]
    385:                         [x2]    [conj(u1)-conj(v1)]  */
    386:   for (k=0; k<eps->nconv; k++) {
    387:     PetscCall(BVGetColumn(U,k,&u1));
    388:     PetscCall(BVGetColumn(V,k,&v1));
    389:     /* x1 = u1 + v1 */
    390:     PetscCall(VecAXPY(u1,1.0,v1));
    391:     /* x2 = conj(u1) - conj(v1) = conj(u1 - v1) = conj((u1 + v1) - 2*v1) */
    392:     PetscCall(VecAYPX(v1,-2.0,u1));
    393:     PetscCall(VecConjugate(v1));
    394:     PetscCall(BVRestoreColumn(U,k,&u1));
    395:     PetscCall(BVRestoreColumn(V,k,&v1));
    396:   }
    397:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    398:   /* Normalize eigenvectors */
    399:   PetscCall(BVSetActiveColumns(eps->V,0,eps->nconv));
    400:   PetscCall(BVNormalize(eps->V,NULL));
    401:   PetscFunctionReturn(PETSC_SUCCESS);
    402: }

    404: /* Full orthogonalization of vector [hx, conj(hx)] against first j vectors in X and Y */
    405: static PetscErrorCode Orthog_ProjectedBSE(Vec hx,BV X,BV Y,PetscInt j,PetscScalar *h,PetscScalar *c,PetscBool *breakdown)
    406: {
    407:   PetscInt i;

    409:   PetscFunctionBegin;
    410:   PetscCall(BVSetActiveColumns(X,0,j));
    411:   PetscCall(BVSetActiveColumns(Y,0,j));
    412:   /* c1 = X^* hx */
    413:   PetscCall(BVDotVec(X,hx,c));
    414:   /* c2 = Y^* conj(hx) */
    415:   PetscCall(VecConjugate(hx));
    416:   PetscCall(BVDotVec(Y,hx,c+j));
    417:   /* c = c1 - c2 */
    418:   for (i=0;i<j;i++) c[i] -= c[i+j];
    419:   /* hx = hx - conj(Y*c) */
    420:   PetscCall(BVMultVec(Y,-1.0,1.0,hx,c));
    421:   PetscCall(VecConjugate(hx));
    422:   /* hx = hx - X*c */
    423:   PetscCall(BVMultVec(X,-1.0,1.0,hx,c));
    424:   /* accumulate orthog coeffs into h */
    425:   for (i=0;i<j;i++) h[i] += c[i];
    426:   PetscFunctionReturn(PETSC_SUCCESS);
    427: }

    429: /* Orthogonalize vector [hx; hy] against first j vectors in X and Y
    430:    The result is a vector [u; conj(u)]. Vector hx is overwritten with u. */
    431: static PetscErrorCode OrthogonalizeVector_ProjectedBSE(Vec hx,Vec hy,BV X,BV Y,PetscInt j,PetscReal *beta,PetscInt k,PetscScalar *h,PetscBool *breakdown)
    432: {
    433:   PetscInt    l,i;
    434:   PetscScalar alpha,alpha1,alpha2;
    435:   Vec         x,y;

    437:   PetscFunctionBegin;
    438:   PetscCall(PetscArrayzero(h,2*j));

    440:   /* Local orthogonalization */
    441:   l = j==k+1?0:j-2;  /* 1st column to orthogonalize against */
    442:   /* alpha = X(:,j-1)'*hx-Y(:,j-1)'*hy */
    443:   PetscCall(BVGetColumn(X,j-1,&x));
    444:   PetscCall(BVGetColumn(Y,j-1,&y));
    445:   PetscCall(VecDotBegin(hx,x,&alpha1));
    446:   PetscCall(VecDotBegin(hy,y,&alpha2));
    447:   PetscCall(VecDotEnd(hx,x,&alpha1));
    448:   PetscCall(VecDotEnd(hy,y,&alpha2));
    449:   PetscCall(BVRestoreColumn(X,j-1,&x));
    450:   PetscCall(BVRestoreColumn(Y,j-1,&y));
    451:   alpha = alpha1-alpha2;
    452:   /* Store coeffs into h */
    453:   for (i=l; i<j-1; i++) h[i] = h[j+i] = beta[i]/2.0;
    454:   h[j-1] = alpha;

    456:   /* Orthogonalize: hx = hx - X(:,l:j-1)*h1 - conj(Y(:,l:j-1))*h2 */
    457:   /* hx = hx - X(:,l:j-1)*h1 */
    458:   PetscCall(BVSetActiveColumns(X,l,j));
    459:   PetscCall(BVSetActiveColumns(Y,l,j));
    460:   PetscCall(BVMultVec(X,-1.0,1.0,hx,h+l));
    461:   /* hx = conj(hx) */
    462:   PetscCall(VecConjugate(hx));
    463:   /* hx = hx - Y(:,l:j-1)*conj(h2) */
    464:   h[2*j-1] = PetscConj(alpha-1.0);
    465:   PetscCall(BVMultVec(Y,-1.0,1.0,hx,h+j+l));
    466:   h[2*j-1] = alpha-1.0;
    467:   /* hx = conj(hx) */
    468:   PetscCall(VecConjugate(hx));

    470:   /* Full orthogonalization */
    471:   PetscCall(Orthog_ProjectedBSE(hx,X,Y,j,h,h+2*j,breakdown));
    472:   PetscFunctionReturn(PETSC_SUCCESS);
    473: }

    475: static PetscErrorCode EPSBSELanczos_ProjectedBSE(EPS eps,BV X,BV Y,Vec v,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown)
    476: {
    477:   PetscInt       j,m = *M;
    478:   Vec            u,x,y,w,f,g,vecs[2];
    479:   Mat            H;
    480:   IS             is[2];
    481:   PetscReal      nrm;
    482:   PetscScalar    *hwork,lhwork[100],gamma;
    483:   PetscContainer container;
    484:   SlepcMatStruct mctx;

    486:   PetscFunctionBegin;
    487:   if (4*m > 100) PetscCall(PetscMalloc1(4*m,&hwork));
    488:   else hwork = lhwork;
    489:   PetscCall(STGetMatrix(eps->st,0,&H));
    490:   PetscCall(MatNestGetISs(H,is,NULL));
    491:   PetscCall(PetscObjectQuery((PetscObject)H,"SlepcMatStruct",(PetscObject*)&container));
    492:   PetscCall(PetscContainerGetPointer(container,(void**)&mctx));

    494:   /* create work vectors */
    495:   PetscCall(BVGetColumn(Y,0,&u));
    496:   PetscCall(VecDuplicate(u,&w));
    497:   vecs[0] = u;
    498:   vecs[1] = w;
    499:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&f));
    500:   PetscCall(VecCreateNest(PetscObjectComm((PetscObject)eps),2,is,vecs,&g));
    501:   PetscCall(BVRestoreColumn(Y,0,&u));

    503:   /* Normalize initial vector */
    504:   if (k==0) {
    505:     if (eps->nini==0) PetscCall(BVSetRandomColumn(eps->V,0));
    506:     PetscCall(BVGetColumn(X,0,&x));
    507:     /* v = Hmult(u,1) */
    508:     PetscCall(BVGetColumn(Y,0,&y));
    509:     PetscCall(VecNestSetSubVec(f,0,x));
    510:     PetscCall(VecNestSetSubVec(g,0,y));
    511:     mctx->s = 1.0;
    512:     PetscCall(STApply(eps->st,f,g));
    513:     /* nrm = sqrt(real(u'*v)) */
    514:     PetscCall(VecDot(y,x,&gamma));
    515:     nrm = PetscSqrtReal(PetscRealPart(gamma));
    516:     /* u = u /(nrm*2) */
    517:     PetscCall(VecScale(x,1.0/(2.0*nrm)));
    518:     /* v = v /(nrm*2) */
    519:     PetscCall(VecScale(y,1.0/(2.0*nrm)));
    520:     PetscCall(VecCopy(y,v));
    521:     /* X(:,1) = (u+v) */
    522:     PetscCall(VecAXPY(x,1,y));
    523:     /* Y(:,1) = conj(u-v) */
    524:     PetscCall(VecAYPX(y,-2,x));
    525:     PetscCall(VecConjugate(y));
    526:     PetscCall(BVRestoreColumn(X,0,&x));
    527:     PetscCall(BVRestoreColumn(Y,0,&y));
    528:   }

    530:   for (j=k;j<m;j++) {
    531:     /* j+1 columns (indexes 0 to j) have been computed */
    532:     PetscCall(BVGetColumn(X,j+1,&x));
    533:     PetscCall(BVGetColumn(Y,j+1,&y));
    534:     /* u = Hmult(v,-1)*/
    535:     PetscCall(VecNestSetSubVec(f,0,v));
    536:     PetscCall(VecNestSetSubVec(g,0,x));
    537:     mctx->s = -1.0;
    538:     PetscCall(STApply(eps->st,f,g));
    539:     /* hx = (u+v) */
    540:     PetscCall(VecCopy(x,y));
    541:     PetscCall(VecAXPY(x,1,v));
    542:     /* hy = conj(u-v) */
    543:     PetscCall(VecAXPY(y,-1,v));
    544:     PetscCall(VecConjugate(y));
    545:     /* [u,cd] = orthog(hx,hy,X(:,1:j),Y(:,1:j),opt)*/
    546:     PetscCall(OrthogonalizeVector_ProjectedBSE(x,y,X,Y,j+1,beta,k,hwork,breakdown));
    547:     /* alpha(j) = 2*(real(cd(j))-1/2) */
    548:     alpha[j] = 2*(PetscRealPart(hwork[j]) - 0.5);
    549:     /* v = Hmult(u,1) */
    550:     PetscCall(VecNestSetSubVec(f,0,x));
    551:     PetscCall(VecNestSetSubVec(g,0,y));
    552:     mctx->s = 1.0;
    553:     PetscCall(STApply(eps->st,f,g));
    554:     /* nrm = sqrt(real(u'*v)) */
    555:     /* beta(j) = 2*nrm */
    556:     PetscCall(VecDot(x,y,&gamma));
    557:     beta[j] = 2.0*PetscSqrtReal(PetscRealPart(gamma));
    558:     /* u = u/(nrm*2) */
    559:     PetscCall(VecScale(x,1.0/beta[j]));
    560:     /* v = v/(nrm*2) */
    561:     PetscCall(VecScale(y,1.0/beta[j]));
    562:     PetscCall(VecCopy(y,v));
    563:     /* X(:,j+1) = (u+v) */
    564:     PetscCall(VecAXPY(x,1,y));
    565:     /* Y(:,j+1) = conj(u-v) */
    566:     PetscCall(VecAYPX(y,-2,x));
    567:     PetscCall(VecConjugate(y));
    568:     /* Restore */
    569:     PetscCall(BVRestoreColumn(X,j+1,&x));
    570:     PetscCall(BVRestoreColumn(Y,j+1,&y));
    571:   }
    572:   if (4*m > 100) PetscCall(PetscFree(hwork));
    573:   PetscCall(VecDestroy(&w));
    574:   PetscCall(VecDestroy(&f));
    575:   PetscCall(VecDestroy(&g));
    576:   PetscFunctionReturn(PETSC_SUCCESS);
    577: }

    579: static PetscErrorCode EPSComputeVectors_BSE_ProjectedBSE(EPS eps)
    580: {
    581:   Mat         H;
    582:   Vec         x1,y1,cx1,cy1;
    583:   BV          X,Y;
    584:   IS          is[2];
    585:   PetscInt    k;
    586:   PetscScalar delta1,delta2,lambda;

    588:   PetscFunctionBegin;
    589:   PetscCall(STGetMatrix(eps->st,0,&H));
    590:   PetscCall(MatNestGetISs(H,is,NULL));
    591:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&X,&Y));
    592:   PetscCall(BVCreateVec(X,&cx1));
    593:   PetscCall(BVCreateVec(Y,&cy1));
    594:   for (k=0; k<eps->nconv; k++) {
    595:     /* approx eigenvector is [ delta1*x1 + delta2*conj(y1) ]
    596:                              [ delta1*y1 + delta2*conj(x1) ] */
    597:     lambda = eps->eigr[k];
    598:     PetscCall(STBackTransform(eps->st,1,&lambda,&eps->eigi[k]));
    599:     delta1 = lambda+1.0;
    600:     delta2 = lambda-1.0;
    601:     PetscCall(BVGetColumn(X,k,&x1));
    602:     PetscCall(BVGetColumn(Y,k,&y1));
    603:     PetscCall(VecCopy(x1,cx1));
    604:     PetscCall(VecCopy(y1,cy1));
    605:     PetscCall(VecConjugate(cx1));
    606:     PetscCall(VecConjugate(cy1));
    607:     PetscCall(VecScale(x1,delta1));
    608:     PetscCall(VecScale(y1,delta1));
    609:     PetscCall(VecAXPY(x1,delta2,cy1));
    610:     PetscCall(VecAXPY(y1,delta2,cx1));
    611:     PetscCall(BVRestoreColumn(X,k,&x1));
    612:     PetscCall(BVRestoreColumn(Y,k,&y1));
    613:   }
    614:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&X,&Y));
    615:   PetscCall(BVSetActiveColumns(eps->V,0,eps->nconv));
    616:   /* Normalize eigenvector */
    617:   PetscCall(BVNormalize(eps->V,NULL));
    618:   PetscCall(VecDestroy(&cx1));
    619:   PetscCall(VecDestroy(&cy1));
    620:   PetscFunctionReturn(PETSC_SUCCESS);
    621: }

    623: PetscErrorCode EPSSetUp_KrylovSchur_BSE(EPS eps)
    624: {
    625:   EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
    626:   PetscBool       flg,sinvert;

    628:   PetscFunctionBegin;
    629:   PetscCheck((eps->problem_type==EPS_BSE),PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_WRONGSTATE,"Problem type should be BSE");
    630:   EPSCheckUnsupportedCondition(eps,EPS_FEATURE_ARBITRARY | EPS_FEATURE_REGION | EPS_FEATURE_EXTRACTION | EPS_FEATURE_BALANCE,PETSC_TRUE," with BSE structure");
    631:   PetscCall(PetscCitationsRegister(citation,&cited));
    632:   PetscCall(EPSSetDimensions_Default(eps,&eps->nev,&eps->ncv,&eps->mpd));
    633:   PetscCheck(eps->ncv<=eps->nev+eps->mpd,PetscObjectComm((PetscObject)eps),PETSC_ERR_USER_INPUT,"The value of ncv must not be larger than nev+mpd");
    634:   if (eps->max_it==PETSC_DETERMINE) eps->max_it = PetscMax(100,2*eps->n/eps->ncv)*((eps->stop==EPS_STOP_THRESHOLD)?10:1);

    636:   PetscCall(PetscObjectTypeCompareAny((PetscObject)eps->st,&flg,STSINVERT,STSHIFT,""));
    637:   PetscCheck(flg,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Krylov-Schur BSE only supports shift and shift-and-invert ST");
    638:   PetscCall(PetscObjectTypeCompare((PetscObject)eps->st,STSINVERT,&sinvert));
    639:   if (!eps->which) {
    640:     if (sinvert) eps->which = EPS_TARGET_MAGNITUDE;
    641:     else eps->which = EPS_SMALLEST_MAGNITUDE;
    642:   }

    644:   if (!ctx->keep) ctx->keep = 0.5;
    645:   PetscCall(STSetStructured(eps->st,PETSC_TRUE));

    647:   PetscCall(EPSAllocateSolution(eps,1));
    648:   switch (ctx->bse) {
    649:     case EPS_KRYLOVSCHUR_BSE_SHAO:
    650:       eps->ops->solve = EPSSolve_KrylovSchur_BSE_Shao;
    651:       eps->ops->computevectors = EPSComputeVectors_BSE_Shao;
    652:       PetscCall(DSSetType(eps->ds,DSHEP));
    653:       PetscCall(DSSetCompact(eps->ds,PETSC_TRUE));
    654:       PetscCall(DSSetExtraRow(eps->ds,PETSC_TRUE));
    655:       PetscCall(DSAllocate(eps->ds,eps->ncv+1));
    656:       break;
    657:     case EPS_KRYLOVSCHUR_BSE_GRUNING:
    658:       eps->ops->solve = EPSSolve_KrylovSchur_BSE_Gruning;
    659:       eps->ops->computevectors = EPSComputeVectors_BSE_Gruning;
    660:       PetscCall(DSSetType(eps->ds,DSSVD));
    661:       PetscCall(DSSetCompact(eps->ds,PETSC_TRUE));
    662:       PetscCall(DSSetExtraRow(eps->ds,PETSC_TRUE));
    663:       PetscCall(DSAllocate(eps->ds,eps->ncv+1));
    664:       break;
    665:     case EPS_KRYLOVSCHUR_BSE_PROJECTEDBSE:
    666:       eps->ops->solve = EPSSolve_KrylovSchur_BSE_ProjectedBSE;
    667:       eps->ops->computevectors = EPSComputeVectors_BSE_ProjectedBSE;
    668:       PetscCall(DSSetType(eps->ds,DSHEP));
    669:       PetscCall(DSSetCompact(eps->ds,PETSC_TRUE));
    670:       PetscCall(DSSetExtraRow(eps->ds,PETSC_TRUE));
    671:       PetscCall(DSAllocate(eps->ds,eps->ncv+1));
    672:       break;
    673:     default: SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Unexpected error");
    674:   }
    675:   PetscFunctionReturn(PETSC_SUCCESS);
    676: }

    678: PetscErrorCode EPSSolve_KrylovSchur_BSE_Shao(EPS eps)
    679: {
    680:   EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
    681:   PetscInt        i,k,l,ld,nv,nconv=0,nevsave;
    682:   Mat             H,Q;
    683:   BV              U,V;
    684:   IS              is[2];
    685:   PetscReal       *a,*b,beta;
    686:   PetscBool       breakdown=PETSC_FALSE;

    688:   PetscFunctionBegin;
    689:   PetscCall(DSGetLeadingDimension(eps->ds,&ld));

    691:   /* Extract matrix blocks */
    692:   PetscCall(STGetMatrix(eps->st,0,&H));
    693:   PetscCall(MatNestGetISs(H,is,NULL));

    695:   /* Get the split bases */
    696:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));

    698:   nevsave  = eps->nev;
    699:   eps->nev = (eps->nev+1)/2;
    700:   l = 0;

    702:   /* Restart loop */
    703:   while (eps->reason == EPS_CONVERGED_ITERATING) {
    704:     eps->its++;

    706:     /* Compute an nv-step Lanczos factorization */
    707:     nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
    708:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    709:     PetscCall(DSGetArrayReal(eps->ds,DS_MAT_T,&a));
    710:     b = a + ld;
    711:     PetscCall(EPSBSELanczos_Shao(eps,U,V,a,b,eps->nconv+l,&nv,&breakdown));
    712:     beta = b[nv-1];
    713:     PetscCall(DSRestoreArrayReal(eps->ds,DS_MAT_T,&a));
    714:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    715:     PetscCall(DSSetState(eps->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
    716:     PetscCall(BVSetActiveColumns(eps->V,eps->nconv,nv));

    718:     /* Solve projected problem */
    719:     PetscCall(DSSolve(eps->ds,eps->eigr,eps->eigi));
    720:     PetscCall(DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL));
    721:     PetscCall(DSUpdateExtraRow(eps->ds));
    722:     PetscCall(DSSynchronize(eps->ds,eps->eigr,eps->eigi));

    724:     /* Check convergence */
    725:     for (i=0;i<nv;i++) eps->eigr[i] = PetscSqrtReal(PetscRealPart(eps->eigr[i]));
    726:     PetscCall(EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,beta,0.0,1.0,&k));
    727:     EPSSetCtxThreshold(eps,eps->eigr,eps->eigi,k);
    728:     PetscCall((*eps->stopping)(eps,eps->its,eps->max_it,k,eps->nev,&eps->reason,eps->stoppingctx));
    729:     nconv = k;

    731:     /* Update l */
    732:     if (eps->reason != EPS_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
    733:     else l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
    734:     if (!ctx->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged pairs */
    735:     if (l) PetscCall(PetscInfo(eps,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

    737:     if (eps->reason == EPS_CONVERGED_ITERATING) {
    738:       PetscCheck(!breakdown,PetscObjectComm((PetscObject)eps),PETSC_ERR_CONV_FAILED,"Breakdown in BSE Krylov-Schur (beta=%g)",(double)beta);
    739:       /* Prepare the Rayleigh quotient for restart */
    740:       PetscCall(DSTruncate(eps->ds,k+l,PETSC_FALSE));
    741:     }
    742:     /* Update the corresponding vectors
    743:        U(:,idx) = U*Q(:,idx),  V(:,idx) = V*Q(:,idx) */
    744:     PetscCall(DSGetMat(eps->ds,DS_MAT_Q,&Q));
    745:     PetscCall(BVMultInPlace(U,Q,eps->nconv,k+l));
    746:     PetscCall(BVMultInPlace(V,Q,eps->nconv,k+l));
    747:     PetscCall(DSRestoreMat(eps->ds,DS_MAT_Q,&Q));

    749:     if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
    750:       PetscCall(BVCopyColumn(eps->V,nv,k+l));
    751:       if (eps->stop==EPS_STOP_THRESHOLD && nv-k<5) {  /* reallocate */
    752:         eps->ncv = eps->mpd+k;
    753:         PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    754:         PetscCall(EPSReallocateSolution(eps,eps->ncv+1));
    755:         PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));
    756:         for (i=nv;i<eps->ncv;i++) eps->perm[i] = i;
    757:         PetscCall(DSReallocate(eps->ds,eps->ncv+1));
    758:         PetscCall(DSGetLeadingDimension(eps->ds,&ld));
    759:       }
    760:     }
    761:     eps->nconv = k;
    762:     PetscCall(EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,nv));
    763:   }

    765:   eps->nev = nevsave;

    767:   PetscCall(DSTruncate(eps->ds,eps->nconv,PETSC_TRUE));
    768:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    769:   PetscFunctionReturn(PETSC_SUCCESS);
    770: }

    772: /*
    773:    EPSConvergence_Gruning - convergence check based on SVDKrylovConvergence().
    774: */
    775: static PetscErrorCode EPSConvergence_Gruning(EPS eps,PetscBool getall,PetscInt kini,PetscInt nits,PetscInt *kout)
    776: {
    777:   PetscInt       k,marker,ld;
    778:   PetscReal      *alpha,*beta,resnorm;
    779:   PetscBool      extra;

    781:   PetscFunctionBegin;
    782:   *kout = 0;
    783:   PetscCall(DSGetLeadingDimension(eps->ds,&ld));
    784:   PetscCall(DSGetExtraRow(eps->ds,&extra));
    785:   PetscCheck(extra,PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Only implemented for DS with extra row");
    786:   marker = -1;
    787:   if (eps->trackall) getall = PETSC_TRUE;
    788:   PetscCall(DSGetArrayReal(eps->ds,DS_MAT_T,&alpha));
    789:   beta = alpha + ld;
    790:   for (k=kini;k<kini+nits;k++) {
    791:     resnorm = PetscAbsReal(beta[k]);
    792:     PetscCall((*eps->converged)(eps,eps->eigr[k],eps->eigi[k],resnorm,&eps->errest[k],eps->convergedctx));
    793:     if (marker==-1 && eps->errest[k] >= eps->tol) marker = k;
    794:     if (marker!=-1 && !getall) break;
    795:   }
    796:   PetscCall(DSRestoreArrayReal(eps->ds,DS_MAT_T,&alpha));
    797:   if (marker!=-1) k = marker;
    798:   *kout = k;
    799:   PetscFunctionReturn(PETSC_SUCCESS);
    800: }

    802: PetscErrorCode EPSSolve_KrylovSchur_BSE_Gruning(EPS eps)
    803: {
    804:   EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
    805:   PetscInt        i,k,l,ld,nv,nconv=0,nevsave;
    806:   Mat             H,Q,Z;
    807:   BV              U,V,HU,HV;
    808:   IS              is[2];
    809:   PetscReal       *d1,*d2,beta;
    810:   PetscBool       breakdown=PETSC_FALSE;

    812:   PetscFunctionBegin;
    813:   PetscCall(DSGetLeadingDimension(eps->ds,&ld));

    815:   /* Extract matrix blocks */
    816:   PetscCall(STGetMatrix(eps->st,0,&H));
    817:   PetscCall(MatNestGetISs(H,is,NULL));

    819:   /* Get the split bases */
    820:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));

    822:   /* Create HU and HV */
    823:   PetscCall(BVDuplicate(U,&HU));
    824:   PetscCall(BVDuplicate(V,&HV));

    826:   nevsave  = eps->nev;
    827:   eps->nev = (eps->nev+1)/2;
    828:   l = 0;

    830:   /* Restart loop */
    831:   while (eps->reason == EPS_CONVERGED_ITERATING) {
    832:     eps->its++;

    834:     /* Compute an nv-step Lanczos factorization */
    835:     nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
    836:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    837:     PetscCall(DSGetArrayReal(eps->ds,DS_MAT_T,&d1));
    838:     d2 = d1 + ld;
    839:     PetscCall(EPSBSELanczos_Gruning(eps,U,V,HU,HV,d1,d2,eps->nconv+l,&nv,&breakdown));
    840:     beta = d1[nv-1];
    841:     PetscCall(DSRestoreArrayReal(eps->ds,DS_MAT_T,&d1));

    843:     /* Compute SVD */
    844:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    845:     PetscCall(DSSVDSetDimensions(eps->ds,nv));
    846:     PetscCall(DSSetState(eps->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
    847:     PetscCall(BVSetActiveColumns(eps->V,eps->nconv,nv));

    849:     PetscCall(DSSolve(eps->ds,eps->eigr,eps->eigi));
    850:     PetscCall(DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL));
    851:     PetscCall(DSUpdateExtraRow(eps->ds));
    852:     PetscCall(DSSynchronize(eps->ds,eps->eigr,eps->eigi));

    854:     /* Check convergence */
    855:     PetscCall(EPSConvergence_Gruning(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,&k));
    856:     EPSSetCtxThreshold(eps,eps->eigr,eps->eigi,k);
    857:     PetscCall((*eps->stopping)(eps,eps->its,eps->max_it,k,eps->nev,&eps->reason,eps->stoppingctx));
    858:     nconv = k;

    860:     /* Update l */
    861:     if (eps->reason != EPS_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
    862:     else l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
    863:     if (!ctx->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged pairs */
    864:     if (l) PetscCall(PetscInfo(eps,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

    866:     if (eps->reason == EPS_CONVERGED_ITERATING) {
    867:       PetscCheck(!breakdown,PetscObjectComm((PetscObject)eps),PETSC_ERR_CONV_FAILED,"Breakdown in BSE Krylov-Schur (beta=%g)",(double)beta);
    868:       /* Prepare the Rayleigh quotient for restart */
    869:       PetscCall(DSTruncate(eps->ds,k+l,PETSC_FALSE));
    870:     }
    871:     /* Update the corresponding vectors
    872:        U(:,idx) = U*Q(:,idx),  V(:,idx) = V*Z(:,idx) */
    873:     PetscCall(DSGetMat(eps->ds,DS_MAT_U,&Q));
    874:     PetscCall(DSGetMat(eps->ds,DS_MAT_V,&Z));
    875:     PetscCall(BVMultInPlace(U,Z,eps->nconv,k+l));
    876:     PetscCall(BVMultInPlace(V,Q,eps->nconv,k+l));
    877:     PetscCall(BVMultInPlace(HU,Z,eps->nconv,k+l));
    878:     PetscCall(BVMultInPlace(HV,Q,eps->nconv,k+l));
    879:     PetscCall(DSRestoreMat(eps->ds,DS_MAT_U,&Q));
    880:     PetscCall(DSRestoreMat(eps->ds,DS_MAT_V,&Z));

    882:     if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
    883:       PetscCall(BVCopyColumn(U,nv,k+l));
    884:       PetscCall(BVCopyColumn(HU,nv,k+l));
    885:       if (eps->stop==EPS_STOP_THRESHOLD && nv-k<5) {  /* reallocate */
    886:         eps->ncv = eps->mpd+k;
    887:         PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    888:         PetscCall(EPSReallocateSolution(eps,eps->ncv+1));
    889:         PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));
    890:         PetscCall(BVResize(HU,eps->ncv+1,PETSC_TRUE));
    891:         PetscCall(BVResize(HV,eps->ncv+1,PETSC_TRUE));
    892:         for (i=nv;i<eps->ncv;i++) { eps->perm[i] = i; eps->eigi[i] = 0.0; }
    893:         PetscCall(DSReallocate(eps->ds,eps->ncv+1));
    894:         PetscCall(DSGetLeadingDimension(eps->ds,&ld));
    895:       }
    896:     }
    897:     eps->nconv = k;
    898:     PetscCall(EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,nv));
    899:   }

    901:   eps->nev = nevsave;

    903:   PetscCall(DSTruncate(eps->ds,eps->nconv,PETSC_TRUE));
    904:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));

    906:   PetscCall(BVDestroy(&HU));
    907:   PetscCall(BVDestroy(&HV));
    908:   PetscFunctionReturn(PETSC_SUCCESS);
    909: }

    911: PetscErrorCode EPSSolve_KrylovSchur_BSE_ProjectedBSE(EPS eps)
    912: {
    913:   EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
    914:   PetscInt        i,k,l,ld,nv,nconv=0,nevsave;
    915:   Mat             H,Q;
    916:   Vec             v;
    917:   BV              U,V;
    918:   IS              is[2];
    919:   PetscReal       *a,*b,beta;
    920:   PetscBool       breakdown=PETSC_FALSE;

    922:   PetscFunctionBegin;
    923:   PetscCall(DSGetLeadingDimension(eps->ds,&ld));

    925:   /* Extract matrix blocks */
    926:   PetscCall(STGetMatrix(eps->st,0,&H));
    927:   PetscCall(MatNestGetISs(H,is,NULL));

    929:   /* Get the split bases */
    930:   PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));

    932:   /* Vector v */
    933:   PetscCall(BVCreateVec(V,&v));

    935:   nevsave  = eps->nev;
    936:   eps->nev = (eps->nev+1)/2;
    937:   l = 0;

    939:   /* Restart loop */
    940:   while (eps->reason == EPS_CONVERGED_ITERATING) {
    941:     eps->its++;

    943:     /* Compute an nv-step Lanczos factorization */
    944:     nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
    945:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    946:     PetscCall(DSGetArrayReal(eps->ds,DS_MAT_T,&a));
    947:     b = a + ld;
    948:     PetscCall(EPSBSELanczos_ProjectedBSE(eps,U,V,v,a,b,eps->nconv+l,&nv,&breakdown));
    949:     beta = b[nv-1];
    950:     PetscCall(DSRestoreArrayReal(eps->ds,DS_MAT_T,&a));
    951:     PetscCall(DSSetDimensions(eps->ds,nv,eps->nconv,eps->nconv+l));
    952:     PetscCall(DSSetState(eps->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
    953:     PetscCall(BVSetActiveColumns(eps->V,eps->nconv,nv));

    955:     /* Solve projected problem */
    956:     PetscCall(DSSolve(eps->ds,eps->eigr,eps->eigi));
    957:     PetscCall(DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL));
    958:     PetscCall(DSUpdateExtraRow(eps->ds));
    959:     PetscCall(DSSynchronize(eps->ds,eps->eigr,eps->eigi));

    961:     /* Check convergence */
    962:     for (i=0;i<nv;i++) eps->eigr[i] = PetscSqrtReal(PetscRealPart(eps->eigr[i]));
    963:     PetscCall(EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,beta,0.0,1.0,&k));
    964:     EPSSetCtxThreshold(eps,eps->eigr,eps->eigi,k);
    965:     PetscCall((*eps->stopping)(eps,eps->its,eps->max_it,k,eps->nev,&eps->reason,eps->stoppingctx));
    966:     nconv = k;

    968:     /* Update l */
    969:     if (eps->reason != EPS_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
    970:     else l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
    971:     if (!ctx->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged pairs */
    972:     if (l) PetscCall(PetscInfo(eps,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

    974:     if (eps->reason == EPS_CONVERGED_ITERATING) {
    975:       PetscCheck(!breakdown,PetscObjectComm((PetscObject)eps),PETSC_ERR_CONV_FAILED,"Breakdown in BSE Krylov-Schur (beta=%g)",(double)beta);
    976:       /* Prepare the Rayleigh quotient for restart */
    977:       PetscCall(DSTruncate(eps->ds,k+l,PETSC_FALSE));
    978:     }
    979:     /* Update the corresponding vectors
    980:        U(:,idx) = U*Q(:,idx),  V(:,idx) = V*Q(:,idx) */
    981:     PetscCall(DSGetMat(eps->ds,DS_MAT_Q,&Q));
    982:     PetscCall(BVMultInPlace(U,Q,eps->nconv,k+l));
    983:     PetscCall(BVMultInPlace(V,Q,eps->nconv,k+l));
    984:     PetscCall(DSRestoreMat(eps->ds,DS_MAT_Q,&Q));

    986:     if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
    987:       PetscCall(BVCopyColumn(eps->V,nv,k+l));
    988:       if (eps->stop==EPS_STOP_THRESHOLD && nv-k<5) {  /* reallocate */
    989:         eps->ncv = eps->mpd+k;
    990:         PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));
    991:         PetscCall(EPSReallocateSolution(eps,eps->ncv+1));
    992:         PetscCall(BVGetSplitRows(eps->V,is[0],is[1],&U,&V));
    993:         for (i=nv;i<eps->ncv;i++) eps->perm[i] = i;
    994:         PetscCall(DSReallocate(eps->ds,eps->ncv+1));
    995:         PetscCall(DSGetLeadingDimension(eps->ds,&ld));
    996:       }
    997:     }
    998:     eps->nconv = k;
    999:     PetscCall(EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,nv));
    1000:   }

    1002:   eps->nev = nevsave;

    1004:   PetscCall(DSTruncate(eps->ds,eps->nconv,PETSC_TRUE));
    1005:   PetscCall(BVRestoreSplitRows(eps->V,is[0],is[1],&U,&V));

    1007:   PetscCall(VecDestroy(&v));
    1008:   PetscFunctionReturn(PETSC_SUCCESS);
    1009: }