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

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

      1: /*
      2:    This file implements a wrapper to the FEAST package

      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/epsimpl.h>        /*I "slepceps.h" I*/
     25: #include <../src/eps/impls/external/feast/feastp.h>

     27: PetscErrorCode EPSSolve_FEAST(EPS);

     31: PetscErrorCode EPSSetUp_FEAST(EPS eps)
     32: {
     34:   PetscInt       ncv;
     35:   PetscBool      issinv,flg;
     36:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;
     37:   PetscMPIInt    size;

     40:   MPI_Comm_size(PetscObjectComm((PetscObject)eps),&size);
     41:   if (size!=1) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"The FEAST interface is supported for sequential runs only");
     42:   if (eps->ncv) {
     43:     if (eps->ncv<eps->nev+2) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_OUTOFRANGE,"The value of ncv must be at least nev+2");
     44:   } else eps->ncv = PetscMin(PetscMax(20,2*eps->nev+1),eps->n); /* set default value of ncv */
     45:   if (eps->mpd) { PetscInfo(eps,"Warning: parameter mpd ignored\n"); }
     46:   if (!eps->max_it) eps->max_it = PetscMax(300,(PetscInt)(2*eps->n/eps->ncv));
     47:   if (!eps->which) eps->which = EPS_ALL;

     49:   ncv = eps->ncv;
     50:   PetscFree4(ctx->work1,ctx->work2,ctx->Aq,ctx->Bq);
     51:   PetscMalloc4(eps->nloc*ncv,&ctx->work1,eps->nloc*ncv,&ctx->work2,ncv*ncv,&ctx->Aq,ncv*ncv,&ctx->Bq);
     52:   PetscLogObjectMemory((PetscObject)eps,(2*eps->nloc*ncv+2*ncv*ncv)*sizeof(PetscScalar));

     54:   if (!((PetscObject)(eps->st))->type_name) { /* default to shift-and-invert */
     55:     STSetType(eps->st,STSINVERT);
     56:   }
     57:   PetscObjectTypeCompareAny((PetscObject)eps->st,&issinv,STSINVERT,STCAYLEY,"");
     58:   if (!issinv) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Shift-and-invert or Cayley ST is needed for FEAST");

     60:   if (eps->extraction) { PetscInfo(eps,"Warning: extraction type ignored\n"); }

     62:   if (eps->which!=EPS_ALL || (eps->inta==0.0 && eps->intb==0.0)) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_WRONG,"FEAST must be used with a computational interval");
     63:   if (!eps->ishermitian) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"FEAST only available for symmetric/Hermitian eigenproblems");
     64:   if (eps->balance!=EPS_BALANCE_NONE) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Balancing not supported in the FEAST interface");
     65:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");

     67:   if (!ctx->npoints) ctx->npoints = 8;

     69:   EPSAllocateSolution(eps,0);
     70:   PetscObjectTypeCompare((PetscObject)eps->V,BVVECS,&flg);
     71:   if (flg) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This solver requires a BV with contiguous storage");
     72:   EPSSetWorkVecs(eps,1);

     74:   /* dispatch solve method */
     75:   eps->ops->solve = EPSSolve_FEAST;
     76:   return(0);
     77: }

     81: PetscErrorCode EPSSolve_FEAST(EPS eps)
     82: {
     84:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;
     85:   PetscBLASInt   n,fpm[64],ijob,info,nev,ncv,loop;
     86:   PetscReal      *evals,epsout;
     87:   PetscInt       i,k,nmat;
     88:   PetscScalar    *pV,Ze;
     89:   Vec            v0,x,y,w = eps->work[0];
     90:   Mat            A,B;

     93:   PetscBLASIntCast(eps->nev,&nev);
     94:   PetscBLASIntCast(eps->ncv,&ncv);
     95:   PetscBLASIntCast(eps->nloc,&n);

     97:   /* parameters */
     98:   FEASTinit_(fpm);
     99:   fpm[0] = (eps->numbermonitors>0)? 1: 0;                      /* runtime comments */
    100:   fpm[1] = ctx->npoints;                                       /* contour points */
    101:   PetscBLASIntCast(eps->max_it,&fpm[3]);  /* refinement loops */
    102: #if !defined(PETSC_HAVE_MPIUNI)
    103:   PetscBLASIntCast(MPI_Comm_c2f(PetscObjectComm((PetscObject)eps)),&fpm[8]);
    104: #endif

    106:   PetscMalloc1(eps->ncv,&evals);
    107:   VecCreateMPIWithArray(PetscObjectComm((PetscObject)eps),1,eps->nloc,PETSC_DECIDE,NULL,&x);
    108:   VecCreateMPIWithArray(PetscObjectComm((PetscObject)eps),1,eps->nloc,PETSC_DECIDE,NULL,&y);
    109:   BVGetColumn(eps->V,0,&v0);
    110:   VecGetArray(v0,&pV);

    112:   ijob = -1;           /* first call to reverse communication interface */
    113:   STGetNumMatrices(eps->st,&nmat);
    114:   STGetOperators(eps->st,0,&A);
    115:   if (nmat>1) { STGetOperators(eps->st,1,&B); }
    116:   else B = NULL;

    118:   do {

    120:     PetscStackCall("FEASTrci",FEASTrci_(&ijob,&n,&Ze,ctx->work1,ctx->work2,ctx->Aq,ctx->Bq,fpm,&epsout,&loop,&eps->inta,&eps->intb,&eps->ncv,evals,pV,&eps->nconv,eps->errest,&info));

    122:     if (ncv!=eps->ncv) SETERRQ1(PetscObjectComm((PetscObject)eps),1,"FEAST changed value of ncv to %d",ncv);
    123:     if (ijob == 10 || ijob == 20) {
    124:       /* set new quadrature point */
    125:       STSetShift(eps->st,-Ze);
    126:     } else if (ijob == 11 || ijob == 21) {
    127:       /* linear solve (A-sigma*B)\work2, overwrite work2 */
    128:       for (k=0;k<ncv;k++) {
    129:         VecPlaceArray(x,ctx->work2+eps->nloc*k);
    130:         if (ijob == 11) {
    131:           STMatSolve(eps->st,x,w);
    132:         } else {
    133:           STMatSolveTranspose(eps->st,x,w);
    134:         }
    135:         VecCopy(w,x);
    136:         VecScale(x,-1.0);
    137:         VecResetArray(x);
    138:       }
    139:     } else if (ijob == 30 || ijob == 40) {
    140:       /* multiplication A*V or B*V, result in work1 */
    141:       for (k=0;k<fpm[24];k++) {
    142:         VecPlaceArray(x,&pV[(fpm[23]+k-1)*eps->nloc]);
    143:         VecPlaceArray(y,&ctx->work1[(fpm[23]+k-1)*eps->nloc]);
    144:         if (ijob == 30) {
    145:           MatMult(A,x,y);
    146:         } else if (nmat>1) {
    147:           MatMult(B,x,y);
    148:         } else {
    149:           VecCopy(x,y);
    150:         }
    151:         VecResetArray(x);
    152:         VecResetArray(y);
    153:       }
    154:     } else if (ijob != 0) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Internal error in FEAST reverse comunication interface (ijob=%d)",ijob);

    156:   } while (ijob != 0);

    158:   eps->reason = EPS_CONVERGED_TOL;
    159:   eps->its = loop;
    160:   if (info!=0) {
    161:     if (info==1) { /* No eigenvalue has been found in the proposed search interval */
    162:       eps->nconv = 0;
    163:     } else if (info==2) { /* FEAST did not converge "yet" */
    164:       eps->reason = EPS_DIVERGED_ITS;
    165:     } else SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Error reported by FEAST (%d)",info);
    166:   }

    168:   for (i=0;i<eps->nconv;i++) eps->eigr[i] = evals[i];

    170:   VecRestoreArray(v0,&pV);
    171:   BVRestoreColumn(eps->V,0,&v0);
    172:   VecDestroy(&x);
    173:   VecDestroy(&y);
    174:   PetscFree(evals);
    175:   return(0);
    176: }

    180: PetscErrorCode EPSReset_FEAST(EPS eps)
    181: {
    183:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;

    186:   PetscFree4(ctx->work1,ctx->work2,ctx->Aq,ctx->Bq);
    187:   return(0);
    188: }

    192: PetscErrorCode EPSDestroy_FEAST(EPS eps)
    193: {

    197:   PetscFree(eps->data);
    198:   PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",NULL);
    199:   PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",NULL);
    200:   return(0);
    201: }

    205: PetscErrorCode EPSSetFromOptions_FEAST(PetscOptions *PetscOptionsObject,EPS eps)
    206: {
    208:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;
    209:   PetscInt       n;
    210:   PetscBool      flg;

    213:   PetscOptionsHead(PetscOptionsObject,"EPS FEAST Options");

    215:   n = ctx->npoints;
    216:   PetscOptionsInt("-eps_feast_num_points","Number of contour integration points","EPSFEASTSetNumPoints",n,&n,&flg);
    217:   if (flg) {
    218:     EPSFEASTSetNumPoints(eps,n);
    219:   }

    221:   PetscOptionsTail();
    222:   return(0);
    223: }

    227: PetscErrorCode EPSView_FEAST(EPS eps,PetscViewer viewer)
    228: {
    230:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;
    231:   PetscBool      isascii;

    234:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
    235:   if (isascii) {
    236:     PetscViewerASCIIPrintf(viewer,"  FEAST: number of contour integration points=%d\n",ctx->npoints);
    237:   }
    238:   return(0);
    239: }

    243: static PetscErrorCode EPSFEASTSetNumPoints_FEAST(EPS eps,PetscInt npoints)
    244: {
    246:   EPS_FEAST      *ctx = (EPS_FEAST*)eps->data;

    249:   if (npoints == PETSC_DEFAULT) ctx->npoints = 8;
    250:   else {
    251:     PetscBLASIntCast(npoints,&ctx->npoints);
    252:   }
    253:   return(0);
    254: }

    258: /*@
    259:    EPSFEASTSetNumPoints - Sets the number of contour integration points for
    260:    the FEAST package.

    262:    Collective on EPS

    264:    Input Parameters:
    265: +  eps     - the eigenproblem solver context
    266: -  npoints - number of contour integration points

    268:    Options Database Key:
    269: .  -eps_feast_num_points - Sets the number of points

    271:    Level: advanced

    273: .seealso: EPSFEASTGetNumPoints()
    274: @*/
    275: PetscErrorCode EPSFEASTSetNumPoints(EPS eps,PetscInt npoints)
    276: {

    282:   PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt),(eps,npoints));
    283:   return(0);
    284: }

    288: static PetscErrorCode EPSFEASTGetNumPoints_FEAST(EPS eps,PetscInt *npoints)
    289: {
    290:   EPS_FEAST *ctx = (EPS_FEAST*)eps->data;

    293:   if (npoints) *npoints = ctx->npoints;
    294:   return(0);
    295: }

    299: /*@
    300:    EPSFEASTGetNumPoints - Gets the number of contour integration points for
    301:    the FEAST package.

    303:    Collective on EPS

    305:    Input Parameter:
    306: .  eps     - the eigenproblem solver context

    308:    Output Parameter:
    309: -  npoints - number of contour integration points

    311:    Level: advanced

    313: .seealso: EPSFEASTSetNumPoints()
    314: @*/
    315: PetscErrorCode EPSFEASTGetNumPoints(EPS eps,PetscInt *npoints)
    316: {

    321:   PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt*),(eps,npoints));
    322:   return(0);
    323: }

    327: PETSC_EXTERN PetscErrorCode EPSCreate_FEAST(EPS eps)
    328: {
    329:   EPS_FEAST      *ctx;

    333:   PetscNewLog(eps,&ctx);
    334:   eps->data = (void*)ctx;

    336:   eps->ops->setup                = EPSSetUp_FEAST;
    337:   eps->ops->setfromoptions       = EPSSetFromOptions_FEAST;
    338:   eps->ops->destroy              = EPSDestroy_FEAST;
    339:   eps->ops->reset                = EPSReset_FEAST;
    340:   eps->ops->view                 = EPSView_FEAST;
    341:   PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",EPSFEASTSetNumPoints_FEAST);
    342:   PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",EPSFEASTGetNumPoints_FEAST);
    343:   return(0);
    344: }