Date: 2015-09-03T15:05:29+00:00

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

      1: /*
      2:      This file contains some simple default routines for common PEP operations.

      4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      6:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

      8:    This file is part of SLEPc.

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

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

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

     24: #include <slepc/private/pepimpl.h>     /*I "slepcpep.h" I*/

     28: /*@
     29:    PEPSetWorkVecs - Sets a number of work vectors into a PEP object.

     31:    Collective on PEP

     33:    Input Parameters:
     34: +  pep - polynomial eigensolver context
     35: -  nw  - number of work vectors to allocate

     37:    Developers Note:
     38:    This is PETSC_EXTERN because it may be required by user plugin PEP
     39:    implementations.

     41:    Level: developer
     42: @*/
     43: PetscErrorCode PEPSetWorkVecs(PEP pep,PetscInt nw)
     44: {
     46:   Vec            t;

     49:   if (pep->nwork < nw) {
     50:     VecDestroyVecs(pep->nwork,&pep->work);
     51:     pep->nwork = nw;
     52:     BVGetColumn(pep->V,0,&t);
     53:     VecDuplicateVecs(t,nw,&pep->work);
     54:     BVRestoreColumn(pep->V,0,&t);
     55:     PetscLogObjectParents(pep,nw,pep->work);
     56:   }
     57:   return(0);
     58: }

     62: /*
     63:   PEPConvergedEigRelative - Checks convergence relative to the eigenvalue.
     64: */
     65: PetscErrorCode PEPConvergedEigRelative(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
     66: {
     67:   PetscReal w;

     70:   w = SlepcAbsEigenvalue(eigr,eigi);
     71:   *errest = res/w;
     72:   return(0);
     73: }

     77: /*
     78:   PEPConvergedLinear - Checks convergence related to the linearized eigenproblem.
     79: */
     80: PetscErrorCode PEPConvergedLinear(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
     81: {
     83:   PetscScalar    er,ei;
     84:   PetscBool      flg;
     86:   STGetTransform(pep->st,&flg);
     87:   if (!flg) {
     88:     PetscObjectTypeCompare((PetscObject)pep->st,STSINVERT,&flg);
     89:   } else flg = PETSC_FALSE;
     90:   er = eigr; ei = eigi;
     91:   STBackTransform(pep->st,1,&er,&ei);
     92:   if (flg) *errest = res*((pep->nrml[0]+PetscAbsScalar(pep->target)*pep->nrml[1])/SlepcAbsEigenvalue(eigr,eigi))/(pep->nrml[0]+SlepcAbsEigenvalue(er,ei)*pep->nrml[1]);
     93:   else *errest = res*pep->nrml[1]/(pep->nrml[0]+SlepcAbsEigenvalue(er,ei)*pep->nrml[1]);
     94:   return(0);
     95: }

     99: /*
    100:   PEPConvergedNorm - Checks convergence relative to the matrix norms.
    101: */
    102: PetscErrorCode PEPConvergedNorm(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
    103: {
    104:   PetscReal      w=0.0,t;
    105:   PetscInt       j;
    106:   PetscBool      flg;

    110:   /* initialization of matrix norms */
    111:   if (!pep->nrma[pep->nmat-1]) {
    112:     for (j=0;j<pep->nmat;j++) {
    113:       MatHasOperation(pep->A[j],MATOP_NORM,&flg);
    114:       if (!flg) SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_ARG_WRONG,"The convergence test related to the matrix norms requires a matrix norm operation");
    115:       MatNorm(pep->A[j],NORM_INFINITY,&pep->nrma[j]);
    116:     }
    117:   }
    118:   t = SlepcAbsEigenvalue(eigr,eigi);
    119:   for (j=pep->nmat-1;j>=0;j--) {
    120:     w = w*t+pep->nrma[j];
    121:   }
    122:   *errest = res/w;
    123:   return(0);
    124: }

    128: /*
    129:   PEPConvergedAbsolute - Checks convergence absolutely.
    130: */
    131: PetscErrorCode PEPConvergedAbsolute(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
    132: {
    134:   *errest = res;
    135:   return(0);
    136: }

    140: PetscErrorCode PEPBackTransform_Default(PEP pep)
    141: {

    145:   STBackTransform(pep->st,pep->nconv,pep->eigr,pep->eigi);
    146:   return(0);
    147: }

    151: PetscErrorCode PEPComputeVectors_Default(PEP pep)
    152: {
    154:   PetscInt       i;
    155:   Vec            v;
    156: #if !defined(PETSC_USE_COMPLEX)
    157:   Vec            v1;
    158: #endif

    161:   PEPExtractVectors(pep);

    163:   /* Fix eigenvectors if balancing was used */
    164:   if ((pep->scale==PEP_SCALE_DIAGONAL || pep->scale==PEP_SCALE_BOTH) && pep->Dr && (pep->refine!=PEP_REFINE_MULTIPLE)) {
    165:     for (i=0;i<pep->nconv;i++) {
    166:       BVGetColumn(pep->V,i,&v);
    167:       VecPointwiseMult(v,v,pep->Dr);
    168:       BVRestoreColumn(pep->V,i,&v);
    169:     }
    170:   }

    172:   /* normalization */
    173:   for (i=0;i<pep->nconv;i++) {
    174: #if !defined(PETSC_USE_COMPLEX)
    175:     if (pep->eigi[i]!=0.0) {   /* first eigenvalue of a complex conjugate pair */
    176:       BVGetColumn(pep->V,i,&v);
    177:       BVGetColumn(pep->V,i+1,&v1);
    178:       SlepcVecNormalize(v,v1,PETSC_TRUE,NULL);
    179:       BVRestoreColumn(pep->V,i,&v);
    180:       BVRestoreColumn(pep->V,i+1,&v1);
    181:       i++;
    182:     } else   /* real eigenvalue */
    183: #endif
    184:     {
    185:       BVGetColumn(pep->V,i,&v);
    186:       SlepcVecNormalize(v,NULL,PETSC_FALSE,NULL);
    187:       BVRestoreColumn(pep->V,i,&v);
    188:     }
    189:   }
    190:   return(0);
    191: }

    195: /*
    196:    PEPKrylovConvergence - This is the analogue to EPSKrylovConvergence, but
    197:    for polynomial Krylov methods.

    199:    Differences:
    200:    - Always non-symmetric
    201:    - Does not check for STSHIFT
    202:    - No correction factor
    203:    - No support for true residual
    204: */
    205: PetscErrorCode PEPKrylovConvergence(PEP pep,PetscBool getall,PetscInt kini,PetscInt nits,PetscReal beta,PetscInt *kout)
    206: {
    208:   PetscInt       k,newk,marker,ld,inside;
    209:   PetscScalar    re,im;
    210:   PetscReal      resnorm;
    211:   PetscBool      istrivial;

    214:   RGIsTrivial(pep->rg,&istrivial);
    215:   DSGetLeadingDimension(pep->ds,&ld);
    216:   marker = -1;
    217:   if (pep->trackall) getall = PETSC_TRUE;
    218:   for (k=kini;k<kini+nits;k++) {
    219:     /* eigenvalue */
    220:     re = pep->eigr[k];
    221:     im = pep->eigi[k];
    222:     if (!istrivial) {
    223:       STBackTransform(pep->st,1,&re,&im);
    224:       RGCheckInside(pep->rg,1,&re,&im,&inside);
    225:       if (marker==-1 && inside<=0) marker = k;
    226:       re = pep->eigr[k];
    227:       im = pep->eigi[k];
    228:     }
    229:     newk = k;
    230:     DSVectors(pep->ds,DS_MAT_X,&newk,&resnorm);
    231:     resnorm *= beta;
    232:     /* error estimate */
    233:     (*pep->converged)(pep,re,im,resnorm,&pep->errest[k],pep->convergedctx);
    234:     if (marker==-1 && pep->errest[k] >= pep->tol) marker = k;
    235:     if (newk==k+1) {
    236:       pep->errest[k+1] = pep->errest[k];
    237:       k++;
    238:     }
    239:     if (marker!=-1 && !getall) break;
    240:   }
    241:   if (marker!=-1) k = marker;
    242:   *kout = k;
    243:   return(0);
    244: }

    248: /*
    249:   PEPBuildDiagonalScaling - compute two diagonal matrices to be applied for balancing
    250:   in polynomial eigenproblems.
    251: */
    252: PetscErrorCode PEPBuildDiagonalScaling(PEP pep)
    253: {
    255:   PetscInt       it,i,j,k,nmat,nr,e,nz,lst,lend,nc=0,*cols,emax,emin,emaxl,eminl;
    256:   const PetscInt *cidx,*ridx;
    257:   Mat            M,*T,A;
    258:   PetscMPIInt    n;
    259:   PetscBool      cont=PETSC_TRUE,flg=PETSC_FALSE;
    260:   PetscScalar    *array,*Dr,*Dl,t;
    261:   PetscReal      l2,d,*rsum,*aux,*csum,w=1.0;
    262:   MatStructure   str;
    263:   MatInfo        info;

    266:   l2 = 2*PetscLogReal(2.0);
    267:   nmat = pep->nmat;
    268:   PetscMPIIntCast(pep->n,&n);
    269:   STGetMatStructure(pep->st,&str);
    270:   PetscMalloc1(nmat,&T);
    271:   for (k=0;k<nmat;k++) {
    272:     STGetTOperators(pep->st,k,&T[k]);
    273:   }
    274:   /* Form local auxiliar matrix M */
    275:   PetscObjectTypeCompareAny((PetscObject)T[0],&cont,MATMPIAIJ,MATSEQAIJ,"");
    276:   if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]),PETSC_ERR_SUP,"Only for MPIAIJ or SEQAIJ matrix types");
    277:   PetscObjectTypeCompare((PetscObject)T[0],MATMPIAIJ,&cont);
    278:   if (cont) {
    279:     MatMPIAIJGetLocalMat(T[0],MAT_INITIAL_MATRIX,&M);
    280:     flg = PETSC_TRUE;
    281:   } else {
    282:     MatDuplicate(T[0],MAT_COPY_VALUES,&M);
    283:   }
    284:   MatGetInfo(M,MAT_LOCAL,&info);
    285:   nz = info.nz_used;
    286:   MatSeqAIJGetArray(M,&array);
    287:   for (i=0;i<nz;i++) {
    288:     t = PetscAbsScalar(array[i]);
    289:     array[i] = t*t;
    290:   }
    291:   MatSeqAIJRestoreArray(M,&array);
    292:   for (k=1;k<nmat;k++) {
    293:     if (flg) {
    294:       MatMPIAIJGetLocalMat(T[k],MAT_INITIAL_MATRIX,&A);
    295:     } else {
    296:       if (str==SAME_NONZERO_PATTERN) {
    297:         MatCopy(T[k],A,SAME_NONZERO_PATTERN);
    298:       } else {
    299:         MatDuplicate(T[k],MAT_COPY_VALUES,&A);
    300:       }
    301:     }
    302:     MatGetInfo(A,MAT_LOCAL,&info);
    303:     nz = info.nz_used;
    304:     MatSeqAIJGetArray(A,&array);
    305:     for (i=0;i<nz;i++) {
    306:       t = PetscAbsScalar(array[i]);
    307:       array[i] = t*t;
    308:     }
    309:     MatSeqAIJRestoreArray(A,&array);
    310:     w *= pep->slambda*pep->slambda*pep->sfactor;
    311:     MatAXPY(M,w,A,str);
    312:     if (flg || str!=SAME_NONZERO_PATTERN || k==nmat-2) {
    313:       MatDestroy(&A);
    314:     }
    315:   }
    316:   MatGetRowIJ(M,0,PETSC_FALSE,PETSC_FALSE,&nr,&ridx,&cidx,&cont);
    317:   if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]), PETSC_ERR_SUP,"It is not possible to compute scaling diagonals for these PEP matrices");
    318:   MatGetInfo(M,MAT_LOCAL,&info);
    319:   nz = info.nz_used;
    320:   VecGetOwnershipRange(pep->Dl,&lst,&lend);
    321:   PetscMalloc4(nr,&rsum,pep->n,&csum,pep->n,&aux,PetscMin(pep->n-lend+lst,nz),&cols);
    322:   VecSet(pep->Dr,1.0);
    323:   VecSet(pep->Dl,1.0);
    324:   VecGetArray(pep->Dl,&Dl);
    325:   VecGetArray(pep->Dr,&Dr);
    326:   MatSeqAIJGetArray(M,&array);
    327:   PetscMemzero(aux,pep->n*sizeof(PetscReal));
    328:   for (j=0;j<nz;j++) {
    329:     /* Search non-zero columns outsize lst-lend */
    330:     if (aux[cidx[j]]==0 && (cidx[j]<lst || lend<=cidx[j])) cols[nc++] = cidx[j];
    331:     /* Local column sums */
    332:     aux[cidx[j]] += PetscAbsScalar(array[j]);
    333:   }
    334:   for (it=0;it<pep->sits && cont;it++) {
    335:     emaxl = 0; eminl = 0;
    336:     /* Column sum  */
    337:     if (it>0) { /* it=0 has been already done*/
    338:       MatSeqAIJGetArray(M,&array);
    339:       PetscMemzero(aux,pep->n*sizeof(PetscReal));
    340:       for (j=0;j<nz;j++) aux[cidx[j]] += PetscAbsScalar(array[j]);
    341:       MatSeqAIJRestoreArray(M,&array);
    342:     }
    343:     MPI_Allreduce(aux,csum,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)pep->Dr));
    344:     /* Update Dr */
    345:     for (j=lst;j<lend;j++) {
    346:       d = PetscLogReal(csum[j])/l2;
    347:       e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
    348:       d = PetscPowReal(2.0,e);
    349:       Dr[j-lst] *= d;
    350:       aux[j] = d*d;
    351:       emaxl = PetscMax(emaxl,e);
    352:       eminl = PetscMin(eminl,e);
    353:     }
    354:     for (j=0;j<nc;j++) {
    355:       d = PetscLogReal(csum[cols[j]])/l2;
    356:       e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
    357:       d = PetscPowReal(2.0,e);
    358:       aux[cols[j]] = d*d;
    359:       emaxl = PetscMax(emaxl,e);
    360:       eminl = PetscMin(eminl,e);
    361:     }
    362:     /* Scale M */
    363:     MatSeqAIJGetArray(M,&array);
    364:     for (j=0;j<nz;j++) {
    365:       array[j] *= aux[cidx[j]];
    366:     }
    367:     MatSeqAIJRestoreArray(M,&array);
    368:     /* Row sum */
    369:     PetscMemzero(rsum,nr*sizeof(PetscReal));
    370:     MatSeqAIJGetArray(M,&array);
    371:     for (i=0;i<nr;i++) {
    372:       for (j=ridx[i];j<ridx[i+1];j++) rsum[i] += PetscAbsScalar(array[j]);
    373:       /* Update Dl */
    374:       d = PetscLogReal(rsum[i])/l2;
    375:       e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
    376:       d = PetscPowReal(2.0,e);
    377:       Dl[i] *= d;
    378:       /* Scale M */
    379:       for (j=ridx[i];j<ridx[i+1];j++) array[j] *= d*d;
    380:       emaxl = PetscMax(emaxl,e);
    381:       eminl = PetscMin(eminl,e);
    382:     }
    383:     MatSeqAIJRestoreArray(M,&array);
    384:     /* Compute global max and min */
    385:     MPI_Allreduce(&emaxl,&emax,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pep->Dl));
    386:     MPI_Allreduce(&eminl,&emin,1,MPIU_INT,MPI_MIN,PetscObjectComm((PetscObject)pep->Dl));
    387:     if (emax<=emin+2) cont = PETSC_FALSE;
    388:   }
    389:   VecRestoreArray(pep->Dr,&Dr);
    390:   VecRestoreArray(pep->Dl,&Dl);
    391:   /* Free memory*/
    392:   MatDestroy(&M);
    393:   PetscFree4(rsum,csum,aux,cols);
    394:   PetscFree(T);
    395:   return(0);
    396: }

    400: /*
    401:    PEPComputeScaleFactor - compute sfactor as described in [Betcke 2008].
    402: */
    403: PetscErrorCode PEPComputeScaleFactor(PEP pep)
    404: {
    406:   PetscBool      has0,has1,flg;
    407:   PetscReal      norm0,norm1;
    408:   Mat            T[2];
    409:   PEPBasis       basis;
    410:   PetscInt       i;

    413:   if (pep->scale==PEP_SCALE_NONE || pep->scale==PEP_SCALE_DIAGONAL) {  /* no scalar scaling */
    414:     pep->sfactor = 1.0;
    415:     pep->dsfactor = 1.0;
    416:     return(0);
    417:   }
    418:   if (pep->sfactor_set) return(0);  /* user provided value */
    419:   pep->sfactor = 1.0;
    420:   pep->dsfactor = 1.0;
    421:   PEPGetBasis(pep,&basis);
    422:   if (basis==PEP_BASIS_MONOMIAL) {
    423:     STGetTransform(pep->st,&flg);
    424:     if (flg) {
    425:       STGetTOperators(pep->st,0,&T[0]);
    426:       STGetTOperators(pep->st,pep->nmat-1,&T[1]);
    427:     } else {
    428:       T[0] = pep->A[0];
    429:       T[1] = pep->A[pep->nmat-1];
    430:     }
    431:     if (pep->nmat>2) {
    432:       MatHasOperation(T[0],MATOP_NORM,&has0);
    433:       MatHasOperation(T[1],MATOP_NORM,&has1);
    434:       if (has0 && has1) {
    435:         MatNorm(T[0],NORM_INFINITY,&norm0);
    436:         MatNorm(T[1],NORM_INFINITY,&norm1);
    437:         pep->sfactor = PetscPowReal(norm0/norm1,1.0/(pep->nmat-1));
    438:         pep->dsfactor = norm1;
    439:         for (i=pep->nmat-2;i>0;i--) {
    440:           STGetTOperators(pep->st,i,&T[1]);
    441:           MatHasOperation(T[1],MATOP_NORM,&has1);
    442:           if (has1) {
    443:             MatNorm(T[1],NORM_INFINITY,&norm1);
    444:             pep->dsfactor = pep->dsfactor*pep->sfactor+norm1;
    445:           } else break;
    446:         }
    447:         if (has1) {
    448:           pep->dsfactor = pep->dsfactor*pep->sfactor+norm0;
    449:           pep->dsfactor = pep->nmat/pep->dsfactor;
    450:         } else pep->dsfactor = 1.0;
    451:       }
    452:     }
    453:   }
    454:   return(0);
    455: }

    459: /*
    460:    PEPComputeLinearNorms - compute norm for the linearized problem.
    461: */
    462: PetscErrorCode PEPComputeLinearNorms(PEP pep)
    463: {
    464:   PetscErrorCode    ierr;
    465:   PetscReal         out=0.0,nrmd=0.0,max=0.0,summ,summrow,summd=0.0;
    466:   PetscReal         *pbc,*a,*b,*g,t;
    467:   PetscInt          i,m0,m1,ncols,j,k;
    468:   const PetscScalar *vals;
    469:   Mat               *T;

    472:   PetscMalloc2(3*pep->nmat,&pbc,pep->nmat,&T);
    473:   for (i=0;i<pep->nmat;i++) {
    474:     STGetTOperators(pep->st,i,&T[i]);
    475:   }
    476:   a=pbc; b=pbc+pep->nmat; g = b+pep->nmat;
    477:   PEPBasisCoefficients(pep,pbc);
    478:   out = b[0]+a[0];
    479:   for (i=1;i<pep->nmat-2;i++) out = PetscMax(out,a[i]+b[i]+g[i]);
    480:   MatGetOwnershipRange(T[0],&m0,&m1);
    481:   for (i=m0;i<m1;i++) {
    482:     summrow = 0.0;
    483:     t = 1.0;
    484:     for (j=0;j<pep->nmat;j++) {
    485:       summ = 0.0;
    486:       MatGetRow(T[j],i,&ncols,NULL,&vals);
    487:       for (k=0;k<ncols;k++) summ += PetscAbsScalar(vals[k]);
    488:       MatRestoreRow(T[j],i,&ncols,NULL,&vals);
    489:       summ *= t;
    490:       if (j==pep->nmat-1) {
    491:         summd = summ;
    492:         summ *= (b[pep->nmat-2]+g[pep->nmat-2])/a[pep->nmat-2];
    493:       } else summ *= a[pep->nmat-2];
    494:       summrow += summ;
    495:       t *= pep->sfactor;
    496:     }
    497:     nrmd = PetscMax(nrmd,summd);
    498:     max = PetscMax(max,summrow);
    499:   }
    500:   max = PetscMax(max*pep->dsfactor,out);
    501:   MPI_Allreduce(&max,&pep->nrml[0],1,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)pep));
    502:   MPI_Allreduce(&nrmd,&pep->nrml[1],1,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)pep));
    503:   pep->nrml[1] = PetscMax(1.0,pep->nrml[1]*pep->dsfactor);
    504:   PetscFree2(pbc,T);
    505:   return(0);
    506: }

    510: /*
    511:    PEPBasisCoefficients - compute polynomial basis coefficients
    512: */
    513: PetscErrorCode PEPBasisCoefficients(PEP pep,PetscReal *pbc)
    514: {
    515:   PetscReal *ca,*cb,*cg;
    516:   PetscInt  k,nmat=pep->nmat;
    517:
    519:   ca = pbc;
    520:   cb = pbc+nmat;
    521:   cg = pbc+2*nmat;
    522:   switch (pep->basis) {
    523:   case PEP_BASIS_MONOMIAL:
    524:     for (k=0;k<nmat;k++) {
    525:       ca[k] = 1.0; cb[k] = 0.0; cg[k] = 0.0;
    526:     }
    527:     break;
    528:   case PEP_BASIS_CHEBYSHEV1:
    529:     ca[0] = 1.0; cb[0] = 0.0; cg[0] = 0.0;
    530:     for (k=1;k<nmat;k++) {
    531:       ca[k] = .5; cb[k] = 0.0; cg[k] = .5;
    532:     }
    533:     break;
    534:   case PEP_BASIS_CHEBYSHEV2:
    535:     ca[0] = .5; cb[0] = 0.0; cg[0] = 0.0;
    536:     for (k=1;k<nmat;k++) {
    537:       ca[k] = .5; cb[k] = 0.0; cg[k] = .5;
    538:     }
    539:     break;
    540:   case PEP_BASIS_LEGENDRE:
    541:     ca[0] = 1.0; cb[0] = 0.0; cg[0] = 0.0;
    542:     for (k=1;k<nmat;k++) {
    543:       ca[k] = k+1; cb[k] = -2*k; cg[k] = k;
    544:     }
    545:     break;
    546:   case PEP_BASIS_LAGUERRE:
    547:     ca[0] = -1.0; cb[0] = 0.0; cg[0] = 0.0;
    548:     for (k=1;k<nmat;k++) {
    549:       ca[k] = -(k+1); cb[k] = 2*k+1; cg[k] = -k;
    550:     }
    551:     break;
    552:   case PEP_BASIS_HERMITE:
    553:     ca[0] = .5; cb[0] = 0.0; cg[0] = 0.0;
    554:     for (k=1;k<nmat;k++) {
    555:       ca[k] = .5; cb[k] = 0.0; cg[k] = -k;
    556:     }
    557:     break;
    558:   default:
    559:     SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_ARG_OUTOFRANGE,"Invalid 'basis' value");
    560:   }
    561:   return(0);
    562: }

    566: /*
    567:    PEPEvaluateBasis - evaluate the polynomial basis on a given parameter sigma
    568: */
    569: PetscErrorCode PEPEvaluateBasis(PEP pep,PetscScalar sigma,PetscScalar isigma,PetscScalar *vals,PetscScalar *ivals)
    570: {
    571:   PetscInt   nmat=pep->nmat,k;
    572:   PetscReal  *a=pep->pbc,*b=pep->pbc+nmat,*g=pep->pbc+2*nmat;
    573:
    575:   if (ivals) for (k=0;k<nmat;k++) ivals[k] = 0.0;
    576:   vals[0] = 1.0;
    577:   vals[1] = (sigma-b[0])/a[0];
    578: #if !defined(PETSC_USE_COMPLEX)
    579:   if (ivals) ivals[1] = isigma/a[0];
    580: #endif
    581:   for (k=2;k<nmat;k++) {
    582:     vals[k] = ((sigma-b[k-1])*vals[k-1]-g[k-1]*vals[k-2])/a[k-1];
    583:     if (ivals) vals[k] -= isigma*ivals[k-1]/a[k-1];
    584: #if !defined(PETSC_USE_COMPLEX)
    585:     if (ivals) ivals[k] = ((sigma-b[k-1])*ivals[k-1]+isigma*vals[k-1]-g[k-1]*ivals[k-2])/a[k-1];
    586: #endif
    587:   }
    588:   return(0);
    589: }