Actual source code: feast.c
slepc-3.6.1 2015-09-03
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: }