Actual source code: feast.c
1: /*
2: This file implements a wrapper to the FEAST package
4: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
5: SLEPc - Scalable Library for Eigenvalue Problem Computations
6: Copyright (c) 2002-2013, 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;
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: PetscFree(ctx->work1);
51: PetscMalloc(eps->nloc*ncv*sizeof(PetscScalar),&ctx->work1);
52: PetscFree(ctx->work2);
53: PetscMalloc(eps->nloc*ncv*sizeof(PetscScalar),&ctx->work2);
54: PetscLogObjectMemory(eps,2*eps->nloc*ncv*sizeof(PetscScalar));
55: PetscFree(ctx->Aq);
56: PetscMalloc(ncv*ncv*sizeof(PetscScalar),&ctx->Aq);
57: PetscFree(ctx->Bq);
58: PetscMalloc(ncv*ncv*sizeof(PetscScalar),&ctx->Bq);
59: PetscLogObjectMemory(eps,2*ncv*ncv*sizeof(PetscScalar));
61: if (!((PetscObject)(eps->st))->type_name) { /* default to shift-and-invert */
62: STSetType(eps->st,STSINVERT);
63: }
64: PetscObjectTypeCompareAny((PetscObject)eps->st,&issinv,STSINVERT,STCAYLEY,"");
65: if (!issinv) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Shift-and-invert or Cayley ST is needed for FEAST");
67: if (eps->extraction) { PetscInfo(eps,"Warning: extraction type ignored\n"); }
69: 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");
70: if (!eps->ishermitian) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"FEAST only available for symmetric/Hermitian eigenproblems");
71: if (eps->balance!=EPS_BALANCE_NONE) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Balancing not supported in the Arpack interface");
72: if (eps->arbitrary) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Arbitrary selection of eigenpairs not supported in this solver");
74: if (!ctx->npoints) ctx->npoints = 8;
76: EPSAllocateSolution(eps);
77: EPSSetWorkVecs(eps,1);
79: /* dispatch solve method */
80: if (eps->leftvecs) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_SUP,"Left vectors not supported in this solver");
81: eps->ops->solve = EPSSolve_FEAST;
82: return(0);
83: }
87: PetscErrorCode EPSSolve_FEAST(EPS eps)
88: {
90: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
91: PetscBLASInt n,fpm[64],ijob,info,nev,ncv,loop;
92: PetscReal *evals,epsout;
93: PetscInt i,k,nmat;
94: PetscScalar *pV,Ze;
95: Vec x,y,w = eps->work[0];
96: Mat A,B;
99: PetscBLASIntCast(eps->nev,&nev);
100: PetscBLASIntCast(eps->ncv,&ncv);
101: PetscBLASIntCast(eps->nloc,&n);
103: /* parameters */
104: FEASTinit_(fpm);
105: fpm[0] = (eps->numbermonitors>0)? 1: 0; /* runtime comments */
106: fpm[1] = ctx->npoints; /* contour points */
107: PetscBLASIntCast(eps->max_it,&fpm[3]); /* refinement loops */
108: #if !defined(PETSC_HAVE_MPIUNI)
109: PetscBLASIntCast(MPI_Comm_c2f(PetscObjectComm((PetscObject)eps)),&fpm[8]);
110: #endif
112: PetscMalloc(eps->ncv*sizeof(PetscReal),&evals);
113: VecCreateMPIWithArray(PetscObjectComm((PetscObject)eps),1,eps->nloc,PETSC_DECIDE,NULL,&x);
114: VecCreateMPIWithArray(PetscObjectComm((PetscObject)eps),1,eps->nloc,PETSC_DECIDE,NULL,&y);
115: VecGetArray(eps->V[0],&pV);
117: ijob = -1; /* first call to reverse communication interface */
118: STGetNumMatrices(eps->st,&nmat);
119: STGetOperators(eps->st,0,&A);
120: if (nmat>1) { STGetOperators(eps->st,1,&B); }
121: else B = NULL;
123: do {
125: 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));
127: if (ncv!=eps->ncv) SETERRQ1(PetscObjectComm((PetscObject)eps),1,"FEAST changed value of ncv to %d",ncv);
128: if (ijob == 10 || ijob == 20) {
129: /* set new quadrature point */
130: STSetShift(eps->st,-Ze);
131: } else if (ijob == 11 || ijob == 21) {
132: /* linear solve (A-sigma*B)\work2, overwrite work2 */
133: for (k=0;k<ncv;k++) {
134: VecPlaceArray(x,ctx->work2+eps->nloc*k);
135: if (ijob == 11) {
136: STMatSolve(eps->st,1,x,w);
137: } else {
138: STMatSolveTranspose(eps->st,1,x,w);
139: }
140: VecCopy(w,x);
141: VecScale(x,-1.0);
142: VecResetArray(x);
143: }
144: } else if (ijob == 30 || ijob == 40) {
145: /* multiplication A*V or B*V, result in work1 */
146: for (k=0;k<fpm[24];k++) {
147: VecPlaceArray(x,&pV[(fpm[23]+k-1)*eps->nloc]);
148: VecPlaceArray(y,&ctx->work1[(fpm[23]+k-1)*eps->nloc]);
149: MatMult((ijob==30)?A:B,x,y);
150: VecResetArray(x);
151: VecResetArray(y);
152: }
153: } else if (ijob != 0) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Internal error in FEAST reverse comunication interface (ijob=%d)",ijob);
155: } while (ijob != 0);
157: eps->reason = EPS_CONVERGED_TOL;
158: eps->its = loop;
159: if (info!=0) {
160: if (info==1) { /* No eigenvalue has been found in the proposed search interval */
161: eps->nconv = 0;
162: } else if (info==2) { /* FEAST did not converge "yet" */
163: eps->reason = EPS_DIVERGED_ITS;
164: } else SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Error reported by FEAST (%d)",info);
165: }
167: for (i=0;i<eps->nconv;i++) eps->eigr[i] = evals[i];
169: VecRestoreArray(eps->V[0],&pV);
170: VecDestroy(&x);
171: VecDestroy(&y);
172: PetscFree(evals);
173: return(0);
174: }
178: PetscErrorCode EPSReset_FEAST(EPS eps)
179: {
181: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
184: PetscFree(ctx->work1);
185: PetscFree(ctx->work2);
186: PetscFree(ctx->Aq);
187: PetscFree(ctx->Bq);
188: EPSReset_Default(eps);
189: return(0);
190: }
194: PetscErrorCode EPSDestroy_FEAST(EPS eps)
195: {
199: PetscFree(eps->data);
200: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",NULL);
201: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",NULL);
202: return(0);
203: }
207: PetscErrorCode EPSSetFromOptions_FEAST(EPS eps)
208: {
210: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
211: PetscInt n;
212: PetscBool flg;
215: PetscOptionsHead("EPS FEAST Options");
217: n = ctx->npoints;
218: PetscOptionsInt("-eps_feast_num_points","Number of contour integration points","EPSFEASTSetNumPoints",n,&n,&flg);
219: if (flg) {
220: EPSFEASTSetNumPoints(eps,n);
221: }
223: PetscOptionsTail();
224: return(0);
225: }
229: PetscErrorCode EPSView_FEAST(EPS eps,PetscViewer viewer)
230: {
232: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
233: PetscBool isascii;
236: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
237: if (isascii) {
238: PetscViewerASCIIPrintf(viewer," FEAST: number of contour integration points=%d\n",ctx->npoints);
239: }
240: return(0);
241: }
245: static PetscErrorCode EPSFEASTSetNumPoints_FEAST(EPS eps,PetscInt npoints)
246: {
248: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
251: if (npoints == PETSC_DEFAULT) ctx->npoints = 8;
252: else {
253: PetscBLASIntCast(npoints,&ctx->npoints);
254: }
255: return(0);
256: }
260: /*@
261: EPSFEASTSetNumPoints - Sets the number of contour integration points for
262: the FEAST package.
264: Collective on EPS
266: Input Parameters:
267: + eps - the eigenproblem solver context
268: - npoints - number of contour integration points
270: Options Database Key:
271: . -eps_feast_num_points - Sets the number of points
273: Level: advanced
275: .seealso: EPSFEASTGetNumPoints()
276: @*/
277: PetscErrorCode EPSFEASTSetNumPoints(EPS eps,PetscInt npoints)
278: {
284: PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt),(eps,npoints));
285: return(0);
286: }
290: static PetscErrorCode EPSFEASTGetNumPoints_FEAST(EPS eps,PetscInt *npoints)
291: {
292: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
295: if (npoints) *npoints = ctx->npoints;
296: return(0);
297: }
301: /*@
302: EPSFEASTGetNumPoints - Gets the number of contour integration points for
303: the FEAST package.
305: Collective on EPS
307: Input Parameter:
308: . eps - the eigenproblem solver context
310: Output Parameter:
311: - npoints - number of contour integration points
313: Level: advanced
315: .seealso: EPSFEASTSetNumPoints()
316: @*/
317: PetscErrorCode EPSFEASTGetNumPoints(EPS eps,PetscInt *npoints)
318: {
323: PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt*),(eps,npoints));
324: return(0);
325: }
329: PETSC_EXTERN PetscErrorCode EPSCreate_FEAST(EPS eps)
330: {
334: PetscNewLog(eps,EPS_FEAST,&eps->data);
335: eps->ops->setup = EPSSetUp_FEAST;
336: eps->ops->setfromoptions = EPSSetFromOptions_FEAST;
337: eps->ops->destroy = EPSDestroy_FEAST;
338: eps->ops->reset = EPSReset_FEAST;
339: eps->ops->view = EPSView_FEAST;
340: eps->ops->computevectors = EPSComputeVectors_Default;
341: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",EPSFEASTSetNumPoints_FEAST);
342: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",EPSFEASTGetNumPoints_FEAST);
343: return(0);
344: }