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: if (ijob == 30) {
150: MatMult(A,x,y);
151: } else if (nmat>1) {
152: MatMult(B,x,y);
153: } else {
154: VecCopy(x,y);
155: }
156: VecResetArray(x);
157: VecResetArray(y);
158: }
159: } else if (ijob != 0) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Internal error in FEAST reverse comunication interface (ijob=%d)",ijob);
161: } while (ijob != 0);
163: eps->reason = EPS_CONVERGED_TOL;
164: eps->its = loop;
165: if (info!=0) {
166: if (info==1) { /* No eigenvalue has been found in the proposed search interval */
167: eps->nconv = 0;
168: } else if (info==2) { /* FEAST did not converge "yet" */
169: eps->reason = EPS_DIVERGED_ITS;
170: } else SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_LIB,"Error reported by FEAST (%d)",info);
171: }
173: for (i=0;i<eps->nconv;i++) eps->eigr[i] = evals[i];
175: VecRestoreArray(eps->V[0],&pV);
176: VecDestroy(&x);
177: VecDestroy(&y);
178: PetscFree(evals);
179: return(0);
180: }
184: PetscErrorCode EPSReset_FEAST(EPS eps)
185: {
187: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
190: PetscFree(ctx->work1);
191: PetscFree(ctx->work2);
192: PetscFree(ctx->Aq);
193: PetscFree(ctx->Bq);
194: EPSReset_Default(eps);
195: return(0);
196: }
200: PetscErrorCode EPSDestroy_FEAST(EPS eps)
201: {
205: PetscFree(eps->data);
206: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",NULL);
207: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",NULL);
208: return(0);
209: }
213: PetscErrorCode EPSSetFromOptions_FEAST(EPS eps)
214: {
216: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
217: PetscInt n;
218: PetscBool flg;
221: PetscOptionsHead("EPS FEAST Options");
223: n = ctx->npoints;
224: PetscOptionsInt("-eps_feast_num_points","Number of contour integration points","EPSFEASTSetNumPoints",n,&n,&flg);
225: if (flg) {
226: EPSFEASTSetNumPoints(eps,n);
227: }
229: PetscOptionsTail();
230: return(0);
231: }
235: PetscErrorCode EPSView_FEAST(EPS eps,PetscViewer viewer)
236: {
238: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
239: PetscBool isascii;
242: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);
243: if (isascii) {
244: PetscViewerASCIIPrintf(viewer," FEAST: number of contour integration points=%d\n",ctx->npoints);
245: }
246: return(0);
247: }
251: static PetscErrorCode EPSFEASTSetNumPoints_FEAST(EPS eps,PetscInt npoints)
252: {
254: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
257: if (npoints == PETSC_DEFAULT) ctx->npoints = 8;
258: else {
259: PetscBLASIntCast(npoints,&ctx->npoints);
260: }
261: return(0);
262: }
266: /*@
267: EPSFEASTSetNumPoints - Sets the number of contour integration points for
268: the FEAST package.
270: Collective on EPS
272: Input Parameters:
273: + eps - the eigenproblem solver context
274: - npoints - number of contour integration points
276: Options Database Key:
277: . -eps_feast_num_points - Sets the number of points
279: Level: advanced
281: .seealso: EPSFEASTGetNumPoints()
282: @*/
283: PetscErrorCode EPSFEASTSetNumPoints(EPS eps,PetscInt npoints)
284: {
290: PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt),(eps,npoints));
291: return(0);
292: }
296: static PetscErrorCode EPSFEASTGetNumPoints_FEAST(EPS eps,PetscInt *npoints)
297: {
298: EPS_FEAST *ctx = (EPS_FEAST*)eps->data;
301: if (npoints) *npoints = ctx->npoints;
302: return(0);
303: }
307: /*@
308: EPSFEASTGetNumPoints - Gets the number of contour integration points for
309: the FEAST package.
311: Collective on EPS
313: Input Parameter:
314: . eps - the eigenproblem solver context
316: Output Parameter:
317: - npoints - number of contour integration points
319: Level: advanced
321: .seealso: EPSFEASTSetNumPoints()
322: @*/
323: PetscErrorCode EPSFEASTGetNumPoints(EPS eps,PetscInt *npoints)
324: {
329: PetscTryMethod(eps,"EPSFEASTSetNumPoints_C",(EPS,PetscInt*),(eps,npoints));
330: return(0);
331: }
335: PETSC_EXTERN PetscErrorCode EPSCreate_FEAST(EPS eps)
336: {
340: PetscNewLog(eps,EPS_FEAST,&eps->data);
341: eps->ops->setup = EPSSetUp_FEAST;
342: eps->ops->setfromoptions = EPSSetFromOptions_FEAST;
343: eps->ops->destroy = EPSDestroy_FEAST;
344: eps->ops->reset = EPSReset_FEAST;
345: eps->ops->view = EPSView_FEAST;
346: eps->ops->computevectors = EPSComputeVectors_Default;
347: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTSetNumPoints_C",EPSFEASTSetNumPoints_FEAST);
348: PetscObjectComposeFunction((PetscObject)eps,"EPSFEASTGetNumPoints_C",EPSFEASTGetNumPoints_FEAST);
349: return(0);
350: }