Actual source code: blopex.c

slepc-3.6.1 2015-09-03
Report Typos and Errors
  1: /*
  2:    This file implements a wrapper to the BLOPEX 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 "slepc-interface.h"
 26: #include <blopex_lobpcg.h>
 27: #include <blopex_interpreter.h>
 28: #include <blopex_multivector.h>
 29: #include <blopex_temp_multivector.h>

 31: PetscErrorCode EPSSolve_BLOPEX(EPS);

 33: typedef struct {
 34:   lobpcg_Tolerance           tol;
 35:   lobpcg_BLASLAPACKFunctions blap_fn;
 36:   mv_InterfaceInterpreter    ii;
 37:   ST                         st;
 38:   Vec                        w;
 39:   PetscInt                   bs;     /* block size */
 40: } EPS_BLOPEX;

 44: static void Precond_FnSingleVector(void *data,void *x,void *y)
 45: {
 47:   EPS_BLOPEX     *blopex = (EPS_BLOPEX*)data;
 48:   MPI_Comm       comm = PetscObjectComm((PetscObject)blopex->st);
 49:   KSP            ksp;

 52:   STGetKSP(blopex->st,&ksp);CHKERRABORT(comm,ierr);
 53:   KSPSolve(ksp,(Vec)x,(Vec)y);CHKERRABORT(comm,ierr);
 54:   PetscFunctionReturnVoid();
 55: }

 59: static void Precond_FnMultiVector(void *data,void *x,void *y)
 60: {
 61:   EPS_BLOPEX *blopex = (EPS_BLOPEX*)data;

 64:   blopex->ii.Eval(Precond_FnSingleVector,data,x,y);
 65:   PetscFunctionReturnVoid();
 66: }

 70: static void OperatorASingleVector(void *data,void *x,void *y)
 71: {
 73:   EPS_BLOPEX     *blopex = (EPS_BLOPEX*)data;
 74:   MPI_Comm       comm = PetscObjectComm((PetscObject)blopex->st);
 75:   Mat            A,B;
 76:   PetscScalar    sigma;
 77:   PetscInt       nmat;

 80:   STGetNumMatrices(blopex->st,&nmat);CHKERRABORT(comm,ierr);
 81:   STGetOperators(blopex->st,0,&A);CHKERRABORT(comm,ierr);
 82:   if (nmat>1) { STGetOperators(blopex->st,1,&B);CHKERRABORT(comm,ierr); }
 83:   MatMult(A,(Vec)x,(Vec)y);CHKERRABORT(comm,ierr);
 84:   STGetShift(blopex->st,&sigma);CHKERRABORT(comm,ierr);
 85:   if (sigma != 0.0) {
 86:     if (nmat>1) {
 87:       MatMult(B,(Vec)x,blopex->w);CHKERRABORT(comm,ierr);
 88:     } else {
 89:       VecCopy((Vec)x,blopex->w);CHKERRABORT(comm,ierr);
 90:     }
 91:     VecAXPY((Vec)y,-sigma,blopex->w);CHKERRABORT(comm,ierr);
 92:   }
 93:   PetscFunctionReturnVoid();
 94: }

 98: static void OperatorAMultiVector(void *data,void *x,void *y)
 99: {
100:   EPS_BLOPEX *blopex = (EPS_BLOPEX*)data;

103:   blopex->ii.Eval(OperatorASingleVector,data,x,y);
104:   PetscFunctionReturnVoid();
105: }

109: static void OperatorBSingleVector(void *data,void *x,void *y)
110: {
112:   EPS_BLOPEX     *blopex = (EPS_BLOPEX*)data;
113:   MPI_Comm       comm = PetscObjectComm((PetscObject)blopex->st);
114:   Mat            B;

117:   STGetOperators(blopex->st,1,&B);CHKERRABORT(comm,ierr);
118:   MatMult(B,(Vec)x,(Vec)y);CHKERRABORT(comm,ierr);
119:   PetscFunctionReturnVoid();
120: }

124: static void OperatorBMultiVector(void *data,void *x,void *y)
125: {
126:   EPS_BLOPEX *blopex = (EPS_BLOPEX*)data;

129:   blopex->ii.Eval(OperatorBSingleVector,data,x,y);
130:   PetscFunctionReturnVoid();
131: }

135: PetscErrorCode EPSSetDimensions_BLOPEX(EPS eps,PetscInt nev,PetscInt *ncv,PetscInt *mpd)
136: {
138:   EPS_BLOPEX     *ctx = (EPS_BLOPEX*)eps->data;
139:   PetscInt       k;

142:   k = ((eps->nev-1)/ctx->bs+1)*ctx->bs;
143:   if (*ncv) { /* ncv set */
144:     if (*ncv<k) SETERRQ(PetscObjectComm((PetscObject)eps),1,"The value of ncv is not sufficiently large");
145:   } else *ncv = k;
146:   if (!*mpd) *mpd = *ncv;
147:   else { PetscInfo(eps,"Warning: given value of mpd ignored\n"); }
148:   return(0);
149: }

153: PetscErrorCode EPSSetUp_BLOPEX(EPS eps)
154: {
155: #if defined(PETSC_MISSING_LAPACK_POTRF) || defined(PETSC_MISSING_LAPACK_SYGV)
157:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF/SYGV - Lapack routine is unavailable");
158: #else
160:   EPS_BLOPEX     *blopex = (EPS_BLOPEX*)eps->data;
161:   PetscBool      isPrecond,istrivial,flg;

164:   if (!eps->ishermitian || (eps->isgeneralized && !eps->ispositive)) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"blopex only works for Hermitian problems");
165:   if (!blopex->bs) blopex->bs = PetscMin(16,eps->nev);
166:   EPSSetDimensions_BLOPEX(eps,eps->nev,&eps->ncv,&eps->mpd);
167:   if (!eps->max_it) eps->max_it = PetscMax(100,2*eps->n/eps->ncv);
168:   if (!eps->which) eps->which = EPS_SMALLEST_REAL;
169:   if (eps->which!=EPS_SMALLEST_REAL) SETERRQ(PetscObjectComm((PetscObject)eps),1,"Wrong value of eps->which");
170:   if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");
171:   if (eps->extraction) { PetscInfo(eps,"Warning: extraction type ignored\n"); }
172:   RGIsTrivial(eps->rg,&istrivial);
173:   if (!istrivial) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"This solver does not support region filtering");

175:   STSetUp(eps->st);
176:   PetscObjectTypeCompare((PetscObject)eps->st,STPRECOND,&isPrecond);
177:   if (!isPrecond) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"blopex only works with STPRECOND");
178:   blopex->st = eps->st;

180:   if (eps->converged == EPSConvergedEigRelative) {
181:     blopex->tol.absolute = 0.0;
182:     blopex->tol.relative = eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL:eps->tol;
183:   } else if (eps->converged == EPSConvergedAbsolute) {
184:     blopex->tol.absolute = eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL:eps->tol;
185:     blopex->tol.relative = 0.0;
186:   } else SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Convergence test not supported in this solver");

188:   SLEPCSetupInterpreter(&blopex->ii);

190:   /* allocate memory */
191:   if (!eps->V) { EPSGetBV(eps,&eps->V); }
192:   PetscObjectTypeCompareAny((PetscObject)eps->V,&flg,BVVECS,BVCONTIGUOUS,"");
193:   if (!flg) {  /* blopex only works with BVVECS or BVCONTIGUOUS */
194:     BVSetType(eps->V,BVCONTIGUOUS);
195:   }
196:   EPSAllocateSolution(eps,0);
197:   BVCreateVec(eps->V,&blopex->w);
198:   PetscLogObjectParent((PetscObject)eps,(PetscObject)blopex->w);

200: #if defined(PETSC_USE_COMPLEX)
201:   blopex->blap_fn.zpotrf = PETSC_zpotrf_interface;
202:   blopex->blap_fn.zhegv = PETSC_zsygv_interface;
203: #else
204:   blopex->blap_fn.dpotrf = PETSC_dpotrf_interface;
205:   blopex->blap_fn.dsygv = PETSC_dsygv_interface;
206: #endif

208:   /* dispatch solve method */
209:   eps->ops->solve = EPSSolve_BLOPEX;
210:   return(0);
211: #endif
212: }

216: PetscErrorCode EPSSolve_BLOPEX(EPS eps)
217: {
218:   EPS_BLOPEX        *blopex = (EPS_BLOPEX*)eps->data;
219:   PetscScalar       sigma,*eigr=NULL;
220:   PetscReal         *errest=NULL;
221:   int               i,j,info,its,nconv;
222:   double            *residhist=NULL;
223:   PetscErrorCode    ierr;
224:   mv_MultiVectorPtr eigenvectors,constraints;
225: #if defined(PETSC_USE_COMPLEX)
226:   komplex           *lambda=NULL,*lambdahist=NULL;
227: #else
228:   double            *lambda=NULL,*lambdahist=NULL;
229: #endif

232:   STGetShift(eps->st,&sigma);
233:   PetscMalloc1(blopex->bs,&lambda);
234:   if (eps->numbermonitors>0) {
235:     PetscMalloc4(blopex->bs*(eps->max_it+1),&lambdahist,eps->ncv,&eigr,blopex->bs*(eps->max_it+1),&residhist,eps->ncv,&errest);
236:   }

238:   /* Complete the initial basis with random vectors */
239:   for (i=eps->nini;i<eps->ncv;i++) {
240:     BVSetRandomColumn(eps->V,i,eps->rand);
241:   }

243:   while (eps->reason == EPS_CONVERGED_ITERATING) {

245:     /* Create multivector of constraints from leading columns of V */
246:     PetscObjectComposedDataSetInt((PetscObject)eps->V,SLEPC_BLOPEX_USECONSTR,1);
247:     BVSetActiveColumns(eps->V,0,eps->nconv);
248:     constraints = mv_MultiVectorCreateFromSampleVector(&blopex->ii,eps->nds+eps->nconv,eps->V);

250:     /* Create multivector where eigenvectors of this run will be stored */
251:     PetscObjectComposedDataSetInt((PetscObject)eps->V,SLEPC_BLOPEX_USECONSTR,0);
252:     BVSetActiveColumns(eps->V,eps->nconv,eps->nconv+blopex->bs);
253:     eigenvectors = mv_MultiVectorCreateFromSampleVector(&blopex->ii,blopex->bs,eps->V);

255: #if defined(PETSC_USE_COMPLEX)
256:     info = lobpcg_solve_complex(eigenvectors,blopex,OperatorAMultiVector,
257:           eps->isgeneralized?blopex:NULL,eps->isgeneralized?OperatorBMultiVector:NULL,
258:           blopex,Precond_FnMultiVector,constraints,
259:           blopex->blap_fn,blopex->tol,eps->max_it,0,&its,
260:           lambda,lambdahist,blopex->bs,eps->errest+eps->nconv,residhist,blopex->bs);
261: #else
262:     info = lobpcg_solve_double(eigenvectors,blopex,OperatorAMultiVector,
263:           eps->isgeneralized?blopex:NULL,eps->isgeneralized?OperatorBMultiVector:NULL,
264:           blopex,Precond_FnMultiVector,constraints,
265:           blopex->blap_fn,blopex->tol,eps->max_it,0,&its,
266:           lambda,lambdahist,blopex->bs,eps->errest+eps->nconv,residhist,blopex->bs);
267: #endif
268:     if (info>0) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"BLOPEX failed with exit code=%d",info);
269:     mv_MultiVectorDestroy(constraints);
270:     mv_MultiVectorDestroy(eigenvectors);

272:     for (j=0;j<blopex->bs;j++) {
273: #if defined(PETSC_USE_COMPLEX)
274:       eps->eigr[eps->nconv+j] = lambda[j].real+PETSC_i*lambda[j].imag;
275: #else
276:       eps->eigr[eps->nconv+j] = lambda[j];
277: #endif
278:     }

280:     if (eps->numbermonitors>0) {
281:       for (i=0;i<its;i++) {
282:         nconv = 0;
283:         for (j=0;j<blopex->bs;j++) {
284: #if defined(PETSC_USE_COMPLEX)
285:           eigr[eps->nconv+j] = lambdahist[j+i*blopex->bs].real+PETSC_i*lambdahist[j+i*blopex->bs].imag;
286: #else
287:           eigr[eps->nconv+j] = lambdahist[j+i*blopex->bs];
288: #endif
289:           errest[eps->nconv+j] = residhist[j+i*blopex->bs];
290:           if (residhist[j+i*blopex->bs]<=eps->tol) nconv++;
291:         }
292:         EPSMonitor(eps,eps->its+i,eps->nconv+nconv,eigr,eps->eigi,errest,eps->nconv+blopex->bs);
293:       }
294:     }

296:     eps->its += its;
297:     if (info==-1) {
298:       eps->reason = EPS_DIVERGED_ITS;
299:       break;
300:     } else {
301:       for (i=0;i<blopex->bs;i++) {
302:         if (sigma != 0.0) eps->eigr[eps->nconv+i] += sigma;
303:       }
304:       eps->nconv += blopex->bs;
305:       if (eps->nconv>=eps->nev) eps->reason = EPS_CONVERGED_TOL;
306:     }
307:   }

309:   PetscFree(lambda);
310:   if (eps->numbermonitors>0) {
311:     PetscFree4(lambdahist,eigr,residhist,errest);
312:   }
313:   return(0);
314: }

318: static PetscErrorCode EPSBLOPEXSetBlockSize_BLOPEX(EPS eps,PetscInt bs)
319: {
320:   EPS_BLOPEX *ctx = (EPS_BLOPEX*)eps->data;

323:   ctx->bs = bs;
324:   return(0);
325: }

329: /*@
330:    EPSBLOPEXSetBlockSize - Sets the block size of the BLOPEX solver.

332:    Logically Collective on EPS

334:    Input Parameters:
335: +  eps - the eigenproblem solver context
336: -  bs  - the block size

338:    Options Database Key:
339: .  -eps_blopex_blocksize - Sets the block size

341:    Level: advanced

343: .seealso: EPSBLOPEXGetBlockSize()
344: @*/
345: PetscErrorCode EPSBLOPEXSetBlockSize(EPS eps,PetscInt bs)
346: {

352:   PetscTryMethod(eps,"EPSBLOPEXSetBlockSize_C",(EPS,PetscInt),(eps,bs));
353:   return(0);
354: }

358: static PetscErrorCode EPSBLOPEXGetBlockSize_BLOPEX(EPS eps,PetscInt *bs)
359: {
360:   EPS_BLOPEX *ctx = (EPS_BLOPEX*)eps->data;

363:   *bs = ctx->bs;
364:   return(0);
365: }

369: /*@
370:    EPSBLOPEXGetBlockSize - Gets the block size used in the BLOPEX solver.

372:    Not Collective

374:    Input Parameter:
375: .  eps - the eigenproblem solver context

377:    Output Parameter:
378: .  bs - the block size

380:    Level: advanced

382: .seealso: EPSBLOPEXSetBlockSize()
383: @*/
384: PetscErrorCode EPSBLOPEXGetBlockSize(EPS eps,PetscInt *bs)
385: {

391:   PetscTryMethod(eps,"EPSBLOPEXGetBlockSize_C",(EPS,PetscInt*),(eps,bs));
392:   return(0);
393: }

397: PetscErrorCode EPSReset_BLOPEX(EPS eps)
398: {
400:   EPS_BLOPEX     *blopex = (EPS_BLOPEX*)eps->data;

403:   VecDestroy(&blopex->w);
404:   return(0);
405: }

409: PetscErrorCode EPSDestroy_BLOPEX(EPS eps)
410: {

414:   LOBPCG_DestroyRandomContext();
415:   PetscFree(eps->data);
416:   PetscObjectComposeFunction((PetscObject)eps,"EPSBLOPEXSetBlockSize_C",NULL);
417:   PetscObjectComposeFunction((PetscObject)eps,"EPSBLOPEXGetBlockSize_C",NULL);
418:   return(0);
419: }

423: PetscErrorCode EPSView_BLOPEX(EPS eps,PetscViewer viewer)
424: {
426:   EPS_BLOPEX     *ctx = (EPS_BLOPEX*)eps->data;
427:   PetscBool      isascii;

430:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
431:   if (isascii) {
432:     PetscViewerASCIIPrintf(viewer,"  BLOPEX: block size %D\n",ctx->bs);
433:   }
434:   return(0);
435: }

439: PetscErrorCode EPSSetFromOptions_BLOPEX(PetscOptions *PetscOptionsObject,EPS eps)
440: {
442:   KSP            ksp;
443:   PetscBool      flg;
444:   PetscInt       bs;

447:   PetscOptionsHead(PetscOptionsObject,"EPS BLOPEX Options");
448:   PetscOptionsInt("-eps_blopex_blocksize","BLOPEX block size","EPSBLOPEXSetBlockSize",20,&bs,&flg);
449:   if (flg) {
450:     EPSBLOPEXSetBlockSize(eps,bs);
451:   }
452:   LOBPCG_SetFromOptionsRandomContext();

454:   /* Set STPrecond as the default ST */
455:   if (!((PetscObject)eps->st)->type_name) {
456:     STSetType(eps->st,STPRECOND);
457:   }
458:   STPrecondSetKSPHasMat(eps->st,PETSC_TRUE);

460:   /* Set the default options of the KSP */
461:   STGetKSP(eps->st,&ksp);
462:   if (!((PetscObject)ksp)->type_name) {
463:     KSPSetType(ksp,KSPPREONLY);
464:   }
465:   PetscOptionsTail();
466:   return(0);
467: }

471: PETSC_EXTERN PetscErrorCode EPSCreate_BLOPEX(EPS eps)
472: {
473:   EPS_BLOPEX     *ctx;

477:   PetscNewLog(eps,&ctx);
478:   eps->data = (void*)ctx;

480:   eps->ops->setup          = EPSSetUp_BLOPEX;
481:   eps->ops->setfromoptions = EPSSetFromOptions_BLOPEX;
482:   eps->ops->destroy        = EPSDestroy_BLOPEX;
483:   eps->ops->reset          = EPSReset_BLOPEX;
484:   eps->ops->view           = EPSView_BLOPEX;
485:   eps->ops->backtransform  = EPSBackTransform_Default;
486:   LOBPCG_InitRandomContext(PetscObjectComm((PetscObject)eps),eps->rand);
487:   PetscObjectComposeFunction((PetscObject)eps,"EPSBLOPEXSetBlockSize_C",EPSBLOPEXSetBlockSize_BLOPEX);
488:   PetscObjectComposeFunction((PetscObject)eps,"EPSBLOPEXGetBlockSize_C",EPSBLOPEXGetBlockSize_BLOPEX);
489:   return(0);
490: }