Date: 2022-10-01T06:39:44+00:00

Actual source code: epskrylov.c
slepc-3.18.0 2022-10-01
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:    Common subroutines for all Krylov-type solvers
     12: */

     14: #include <slepc/private/epsimpl.h>
     15: #include <slepc/private/slepcimpl.h>
     16: #include <slepcblaslapack.h>

     18: /*
     19:    EPSDelayedArnoldi - This function is equivalent to BVMatArnoldi but
     20:    performs the computation in a different way. The main idea is that
     21:    reorthogonalization is delayed to the next Arnoldi step. This version is
     22:    more scalable but in some cases convergence may stagnate.
     23: */
     24: PetscErrorCode EPSDelayedArnoldi(EPS eps,PetscScalar *H,PetscInt ldh,PetscInt k,PetscInt *M,PetscReal *beta,PetscBool *breakdown)
     25: {
     26:   PetscInt       i,j,m=*M;
     27:   Vec            u,t;
     28:   PetscScalar    shh[100],*lhh,dot,dot2;
     29:   PetscReal      norm1=0.0,norm2=1.0;
     30:   Vec            vj,vj1,vj2=NULL;

     32:   if (m<=100) lhh = shh;
     33:   else PetscMalloc1(m,&lhh);
     34:   BVCreateVec(eps->V,&u);
     35:   BVCreateVec(eps->V,&t);

     37:   BVSetActiveColumns(eps->V,0,m);
     38:   for (j=k;j<m;j++) {
     39:     BVGetColumn(eps->V,j,&vj);
     40:     BVGetColumn(eps->V,j+1,&vj1);
     41:     STApply(eps->st,vj,vj1);
     42:     BVRestoreColumn(eps->V,j,&vj);
     43:     BVRestoreColumn(eps->V,j+1,&vj1);

     45:     BVDotColumnBegin(eps->V,j+1,H+ldh*j);
     46:     if (j>k) {
     47:       BVDotColumnBegin(eps->V,j,lhh);
     48:       BVGetColumn(eps->V,j,&vj);
     49:       VecDotBegin(vj,vj,&dot);
     50:       if (j>k+1) {
     51:         BVNormVecBegin(eps->V,u,NORM_2,&norm2);
     52:         BVGetColumn(eps->V,j-2,&vj2);
     53:         VecDotBegin(u,vj2,&dot2);
     54:       }
     55:       BVDotColumnEnd(eps->V,j+1,H+ldh*j);
     56:       BVDotColumnEnd(eps->V,j,lhh);
     57:       VecDotEnd(vj,vj,&dot);
     58:       BVRestoreColumn(eps->V,j,&vj);
     59:       if (j>k+1) {
     60:         BVNormVecEnd(eps->V,u,NORM_2,&norm2);
     61:         VecDotEnd(u,vj2,&dot2);
     62:         BVRestoreColumn(eps->V,j-2,&vj2);
     63:       }
     64:       norm1 = PetscSqrtReal(PetscRealPart(dot));
     65:       for (i=0;i<j;i++) H[ldh*j+i] = H[ldh*j+i]/norm1;
     66:       H[ldh*j+j] = H[ldh*j+j]/dot;
     67:       BVCopyVec(eps->V,j,t);
     68:       BVScaleColumn(eps->V,j,1.0/norm1);
     69:       BVScaleColumn(eps->V,j+1,1.0/norm1);
     70:     } else BVDotColumnEnd(eps->V,j+1,H+ldh*j); /* j==k */

     72:     BVMultColumn(eps->V,-1.0,1.0,j+1,H+ldh*j);

     74:     if (j>k) {
     75:       BVSetActiveColumns(eps->V,0,j);
     76:       BVMultVec(eps->V,-1.0,1.0,t,lhh);
     77:       BVSetActiveColumns(eps->V,0,m);
     78:       for (i=0;i<j;i++) H[ldh*(j-1)+i] += lhh[i];
     79:     }

     81:     if (j>k+1) {
     82:       BVGetColumn(eps->V,j-1,&vj1);
     83:       VecCopy(u,vj1);
     84:       BVRestoreColumn(eps->V,j-1,&vj1);
     85:       BVScaleColumn(eps->V,j-1,1.0/norm2);
     86:       H[ldh*(j-2)+j-1] = norm2;
     87:     }

     89:     if (j<m-1) VecCopy(t,u);
     90:   }

     92:   BVNormVec(eps->V,t,NORM_2,&norm2);
     93:   VecScale(t,1.0/norm2);
     94:   BVGetColumn(eps->V,m-1,&vj1);
     95:   VecCopy(t,vj1);
     96:   BVRestoreColumn(eps->V,m-1,&vj1);
     97:   H[ldh*(m-2)+m-1] = norm2;

     99:   BVDotColumn(eps->V,m,lhh);

    101:   BVMultColumn(eps->V,-1.0,1.0,m,lhh);
    102:   for (i=0;i<m;i++)
    103:     H[ldh*(m-1)+i] += lhh[i];

    105:   BVNormColumn(eps->V,m,NORM_2,beta);
    106:   BVScaleColumn(eps->V,m,1.0 / *beta);
    107:   *breakdown = PETSC_FALSE;

    109:   if (m>100) PetscFree(lhh);
    110:   VecDestroy(&u);
    111:   VecDestroy(&t);
    112:   return 0;
    113: }

    115: /*
    116:    EPSDelayedArnoldi1 - This function is similar to EPSDelayedArnoldi,
    117:    but without reorthogonalization (only delayed normalization).
    118: */
    119: PetscErrorCode EPSDelayedArnoldi1(EPS eps,PetscScalar *H,PetscInt ldh,PetscInt k,PetscInt *M,PetscReal *beta,PetscBool *breakdown)
    120: {
    121:   PetscInt       i,j,m=*M;
    122:   PetscScalar    dot;
    123:   PetscReal      norm=0.0;
    124:   Vec            vj,vj1;

    126:   BVSetActiveColumns(eps->V,0,m);
    127:   for (j=k;j<m;j++) {
    128:     BVGetColumn(eps->V,j,&vj);
    129:     BVGetColumn(eps->V,j+1,&vj1);
    130:     STApply(eps->st,vj,vj1);
    131:     BVRestoreColumn(eps->V,j+1,&vj1);
    132:     if (j>k) {
    133:       BVDotColumnBegin(eps->V,j+1,H+ldh*j);
    134:       VecDotBegin(vj,vj,&dot);
    135:       BVDotColumnEnd(eps->V,j+1,H+ldh*j);
    136:       VecDotEnd(vj,vj,&dot);
    137:       norm = PetscSqrtReal(PetscRealPart(dot));
    138:       BVScaleColumn(eps->V,j,1.0/norm);
    139:       H[ldh*(j-1)+j] = norm;
    140:       for (i=0;i<j;i++) H[ldh*j+i] = H[ldh*j+i]/norm;
    141:       H[ldh*j+j] = H[ldh*j+j]/dot;
    142:       BVScaleColumn(eps->V,j+1,1.0/norm);
    143:       *beta = norm;
    144:     } else {  /* j==k */
    145:       BVDotColumn(eps->V,j+1,H+ldh*j);
    146:     }
    147:     BVRestoreColumn(eps->V,j,&vj);
    148:     BVMultColumn(eps->V,-1.0,1.0,j+1,H+ldh*j);
    149:   }

    151:   *breakdown = PETSC_FALSE;
    152:   return 0;
    153: }

    155: /*
    156:    EPSKrylovConvergence_Filter - Specialized version for STFILTER.
    157: */
    158: PetscErrorCode EPSKrylovConvergence_Filter(EPS eps,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal beta,PetscReal gamma,PetscInt *kout)
    159: {
    160:   PetscInt       k,ninside,nconv;
    161:   PetscScalar    re,im;
    162:   PetscReal      resnorm;

    164:   ninside = 0;   /* count how many eigenvalues are located in the interval */
    165:   for (k=kini;k<kini+nits;k++) {
    166:     if (PetscRealPart(eps->eigr[k]) < gamma) break;
    167:     ninside++;
    168:   }
    169:   eps->nev = ninside+kini;  /* adjust eigenvalue count */
    170:   nconv = 0;   /* count how many eigenvalues satisfy the convergence criterion */
    171:   for (k=kini;k<kini+ninside;k++) {
    172:     /* eigenvalue */
    173:     re = eps->eigr[k];
    174:     im = eps->eigi[k];
    175:     DSVectors(eps->ds,DS_MAT_X,&k,&resnorm);
    176:     resnorm *= beta;
    177:     /* error estimate */
    178:     (*eps->converged)(eps,re,im,resnorm,&eps->errest[k],eps->convergedctx);
    179:     if (eps->errest[k] < eps->tol) nconv++;
    180:     else break;
    181:   }
    182:   *kout = kini+nconv;
    183:   PetscInfo(eps,"Found %" PetscInt_FMT " eigenvalue approximations inside the interval (gamma=%g), k=%" PetscInt_FMT " nconv=%" PetscInt_FMT "\n",ninside,(double)gamma,k,nconv);
    184:   return 0;
    185: }

    187: /*
    188:    EPSKrylovConvergence - Implements the loop that checks for convergence
    189:    in Krylov methods.

    191:    Input Parameters:
    192:      eps   - the eigensolver; some error estimates are updated in eps->errest
    193:      getall - whether all residuals must be computed
    194:      kini  - initial value of k (the loop variable)
    195:      nits  - number of iterations of the loop
    196:      V     - set of basis vectors (used only if trueresidual is activated)
    197:      nv    - number of vectors to process (dimension of Q, columns of V)
    198:      beta  - norm of f (the residual vector of the Arnoldi/Lanczos factorization)
    199:      corrf - correction factor for residual estimates (only in harmonic KS)

    201:    Output Parameters:
    202:      kout  - the first index where the convergence test failed
    203: */
    204: PetscErrorCode EPSKrylovConvergence(EPS eps,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal beta,PetscReal betat,PetscReal corrf,PetscInt *kout)
    205: {
    206:   PetscInt       k,newk,newk2,marker,ld,inside;
    207:   PetscScalar    re,im,*Zr,*Zi,*X;
    208:   PetscReal      resnorm,gamma,lerrest;
    209:   PetscBool      isshift,isfilter,refined,istrivial;
    210:   Vec            x=NULL,y=NULL,w[3];

    212:   if (PetscUnlikely(eps->which == EPS_ALL)) {
    213:     PetscObjectTypeCompare((PetscObject)eps->st,STFILTER,&isfilter);
    214:     if (isfilter) {
    215:       STFilterGetThreshold(eps->st,&gamma);
    216:       EPSKrylovConvergence_Filter(eps,getall,kini,nits,beta,gamma,kout);
    217:       return 0;
    218:     }
    219:   }
    220:   RGIsTrivial(eps->rg,&istrivial);
    221:   if (PetscUnlikely(eps->trueres)) {
    222:     BVCreateVec(eps->V,&x);
    223:     BVCreateVec(eps->V,&y);
    224:     BVCreateVec(eps->V,&w[0]);
    225:     BVCreateVec(eps->V,&w[2]);
    226: #if !defined(PETSC_USE_COMPLEX)
    227:     BVCreateVec(eps->V,&w[1]);
    228: #else
    229:     w[1] = NULL;
    230: #endif
    231:   }
    232:   DSGetLeadingDimension(eps->ds,&ld);
    233:   DSGetRefined(eps->ds,&refined);
    234:   PetscObjectTypeCompare((PetscObject)eps->st,STSHIFT,&isshift);
    235:   marker = -1;
    236:   if (eps->trackall) getall = PETSC_TRUE;
    237:   for (k=kini;k<kini+nits;k++) {
    238:     /* eigenvalue */
    239:     re = eps->eigr[k];
    240:     im = eps->eigi[k];
    241:     if (!istrivial || eps->trueres || isshift || eps->conv==EPS_CONV_NORM) STBackTransform(eps->st,1,&re,&im);
    242:     if (PetscUnlikely(!istrivial)) {
    243:       RGCheckInside(eps->rg,1,&re,&im,&inside);
    244:       if (marker==-1 && inside<0) marker = k;
    245:       if (!(eps->trueres || isshift || eps->conv==EPS_CONV_NORM)) {  /* make sure eps->converged below uses the right value */
    246:         re = eps->eigr[k];
    247:         im = eps->eigi[k];
    248:       }
    249:     }
    250:     newk = k;
    251:     DSVectors(eps->ds,DS_MAT_X,&newk,&resnorm);
    252:     if (PetscUnlikely(eps->trueres)) {
    253:       DSGetArray(eps->ds,DS_MAT_X,&X);
    254:       Zr = X+k*ld;
    255:       if (newk==k+1) Zi = X+newk*ld;
    256:       else Zi = NULL;
    257:       EPSComputeRitzVector(eps,Zr,Zi,eps->V,x,y);
    258:       DSRestoreArray(eps->ds,DS_MAT_X,&X);
    259:       EPSComputeResidualNorm_Private(eps,PETSC_FALSE,re,im,x,y,w,&resnorm);
    260:     }
    261:     else if (!refined) resnorm *= beta*corrf;
    262:     /* error estimate */
    263:     (*eps->converged)(eps,re,im,resnorm,&eps->errest[k],eps->convergedctx);
    264:     if (marker==-1 && eps->errest[k] >= eps->tol) marker = k;
    265:     if (PetscUnlikely(eps->twosided)) {
    266:       newk2 = k;
    267:       DSVectors(eps->ds,DS_MAT_Y,&newk2,&resnorm);
    268:       resnorm *= betat;
    269:       (*eps->converged)(eps,re,im,resnorm,&lerrest,eps->convergedctx);
    270:       eps->errest[k] = PetscMax(eps->errest[k],lerrest);
    271:       if (marker==-1 && lerrest >= eps->tol) marker = k;
    272:     }
    273:     if (PetscUnlikely(newk==k+1)) {
    274:       eps->errest[k+1] = eps->errest[k];
    275:       k++;
    276:     }
    277:     if (marker!=-1 && !getall) break;
    278:   }
    279:   if (marker!=-1) k = marker;
    280:   *kout = k;
    281:   if (PetscUnlikely(eps->trueres)) {
    282:     VecDestroy(&x);
    283:     VecDestroy(&y);
    284:     VecDestroy(&w[0]);
    285:     VecDestroy(&w[2]);
    286: #if !defined(PETSC_USE_COMPLEX)
    287:     VecDestroy(&w[1]);
    288: #endif
    289:   }
    290:   return 0;
    291: }

    293: PetscErrorCode EPSPseudoLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscReal *omega,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscBool *symmlost,PetscReal *cos,Vec w)
    294: {
    295:   PetscInt       j,m = *M,i,ld,l;
    296:   Vec            vj,vj1;
    297:   PetscScalar    *hwork,lhwork[100];
    298:   PetscReal      norm,norm1,norm2,t,sym=0.0,fro=0.0;
    299:   PetscBLASInt   j_,one=1;

    301:   DSGetLeadingDimension(eps->ds,&ld);
    302:   DSGetDimensions(eps->ds,NULL,&l,NULL,NULL);
    303:   if (cos) *cos = 1.0;
    304:   if (m > 100) PetscMalloc1(m,&hwork);
    305:   else hwork = lhwork;

    307:   BVSetActiveColumns(eps->V,0,m);
    308:   for (j=k;j<m;j++) {
    309:     BVGetColumn(eps->V,j,&vj);
    310:     BVGetColumn(eps->V,j+1,&vj1);
    311:     STApply(eps->st,vj,vj1);
    312:     BVRestoreColumn(eps->V,j,&vj);
    313:     BVRestoreColumn(eps->V,j+1,&vj1);
    314:     BVOrthogonalizeColumn(eps->V,j+1,hwork,&norm,breakdown);
    315:     alpha[j] = PetscRealPart(hwork[j]);
    316:     beta[j] = PetscAbsReal(norm);
    317:     if (j==k) {
    318:       PetscReal *f;

    320:       DSGetArrayReal(eps->ds,DS_MAT_T,&f);
    321:       for (i=0;i<l;i++) hwork[i]  = 0.0;
    322:       for (;i<j-1;i++)  hwork[i] -= f[2*ld+i];
    323:       DSRestoreArrayReal(eps->ds,DS_MAT_T,&f);
    324:     }
    325:     if (j>0) {
    326:       hwork[j-1] -= beta[j-1];
    327:       PetscBLASIntCast(j,&j_);
    328:       sym = SlepcAbs(BLASnrm2_(&j_,hwork,&one),sym);
    329:     }
    330:     fro = SlepcAbs(fro,SlepcAbs(alpha[j],beta[j]));
    331:     if (j>0) fro = SlepcAbs(fro,beta[j-1]);
    332:     if (sym/fro>PetscMax(PETSC_SQRT_MACHINE_EPSILON,10*eps->tol)) { *symmlost = PETSC_TRUE; *M=j+1; break; }
    333:     omega[j+1] = (norm<0.0)? -1.0: 1.0;
    334:     BVScaleColumn(eps->V,j+1,1.0/norm);
    335:     /* */
    336:     if (cos) {
    337:       BVGetColumn(eps->V,j+1,&vj1);
    338:       VecNorm(vj1,NORM_2,&norm1);
    339:       BVApplyMatrix(eps->V,vj1,w);
    340:       BVRestoreColumn(eps->V,j+1,&vj1);
    341:       VecNorm(w,NORM_2,&norm2);
    342:       t = 1.0/(norm1*norm2);
    343:       if (*cos>t) *cos = t;
    344:     }
    345:   }
    346:   if (m > 100) PetscFree(hwork);
    347:   return 0;
    348: }