Actual source code: blzpack.c
2: /*
3: This file implements a wrapper to the BLZPACK package
4: */
5: #include src/eps/impls/blzpack/blzpackp.h
7: const char* blzpack_error[33] = {
8: "",
9: "illegal data, LFLAG ",
10: "illegal data, dimension of (U), (V), (X) ",
11: "illegal data, leading dimension of (U), (V), (X) ",
12: "illegal data, leading dimension of (EIG) ",
13: "illegal data, number of required eigenpairs ",
14: "illegal data, Lanczos algorithm block size ",
15: "illegal data, maximum number of steps ",
16: "illegal data, number of starting vectors ",
17: "illegal data, number of eigenpairs provided ",
18: "illegal data, problem type flag ",
19: "illegal data, spectrum slicing flag ",
20: "illegal data, eigenvectors purification flag ",
21: "illegal data, level of output ",
22: "illegal data, output file unit ",
23: "illegal data, LCOMM (MPI or PVM) ",
24: "illegal data, dimension of ISTOR ",
25: "illegal data, convergence threshold ",
26: "illegal data, dimension of RSTOR ",
27: "illegal data on at least one PE ",
28: "ISTOR(3:14) must be equal on all PEs ",
29: "RSTOR(1:3) must be equal on all PEs ",
30: "not enough space in ISTOR to start eigensolution ",
31: "not enough space in RSTOR to start eigensolution ",
32: "illegal data, number of negative eigenvalues ",
33: "illegal data, entries of V ",
34: "illegal data, entries of X ",
35: "failure in computational subinterval ",
36: "file I/O error, blzpack.__.BQ ",
37: "file I/O error, blzpack.__.BX ",
38: "file I/O error, blzpack.__.Q ",
39: "file I/O error, blzpack.__.X ",
40: "parallel interface error "
41: };
45: PetscErrorCode EPSSetUp_BLZPACK(EPS eps)
46: {
47: PetscErrorCode ierr;
48: int listor, lrstor, ncuv, N, n, k1, k2, k3, k4;
49: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
50: PetscTruth flg;
51: KSP ksp;
52: PC pc;
55: VecGetSize(eps->vec_initial,&N);
56: VecGetLocalSize(eps->vec_initial,&n);
57: if (eps->ncv) {
58: if( eps->ncv < PetscMin(eps->nev+10,eps->nev*2) )
59: SETERRQ(0,"Warning: BLZpack recommends that ncv be larger than min(nev+10,nev*2)");
60: }
61: else eps->ncv = PetscMin(eps->nev+10,eps->nev*2);
62: if (!eps->max_it) eps->max_it = PetscMax(100,N);
63: if (!eps->tol) eps->tol = 1.e-7;
65: #if defined(PETSC_USE_COMPLEX)
66: SETERRQ(PETSC_ERR_SUP,"Requested method is not available for complex problems");
67: #endif
68: if (!eps->ishermitian)
69: SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
70: if (blz->slice) {
71: PetscTypeCompare((PetscObject)eps->OP,STSINV,&flg);
72: if (!flg)
73: SETERRQ(PETSC_ERR_SUP,"Shift-and-invert ST is needed for spectrum slicing");
74: STGetKSP(eps->OP,&ksp);
75: PetscTypeCompare((PetscObject)ksp,KSPPREONLY,&flg);
76: if (!flg)
77: SETERRQ(PETSC_ERR_SUP,"Preonly KSP is needed for spectrum slicing");
78: KSPGetPC(ksp,&pc);
79: PetscTypeCompare((PetscObject)pc,PCCHOLESKY,&flg);
80: if (!flg)
81: SETERRQ(PETSC_ERR_SUP,"Cholesky PC is needed for spectrum slicing");
82: }
83: if (eps->which!=EPS_SMALLEST_REAL)
84: SETERRQ(1,"Wrong value of eps->which");
86: k1 = PetscMin(N,180);
87: k2 = blz->block_size;
88: k4 = PetscMin(eps->ncv,N);
89: k3 = 484+k1*(13+k1*2+k2+PetscMax(18,k2+2))+k2*k2*3+k4*2;
91: listor = 123+k1*12;
92: if (blz->istor) { PetscFree(blz->istor); }
93: PetscMalloc((17+listor)*sizeof(int),&blz->istor);
94: blz->istor[14] = listor;
96: if (blz->slice) lrstor = n*(k2*4+k1*2+k4)+k3;
97: else lrstor = n*(k2*4+k1)+k3;
98: if (blz->rstor) { PetscFree(blz->rstor); }
99: PetscMalloc((4+lrstor)*sizeof(PetscReal),&blz->rstor);
100: blz->rstor[3] = lrstor;
102: ncuv = PetscMax(3,blz->block_size);
103: if (blz->u) { PetscFree(blz->u); }
104: PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->u);
105: if (blz->v) { PetscFree(blz->v); }
106: PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->v);
108: if (blz->eig) { PetscFree(blz->eig); }
109: PetscMalloc(2*eps->ncv*sizeof(PetscReal),&blz->eig);
111: EPSAllocateSolutionContiguous(eps);
112: return(0);
113: }
117: PetscErrorCode EPSSolve_BLZPACK(EPS eps)
118: {
119: PetscErrorCode ierr;
120: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
121: int i, n, nneig, lflag, nvopu;
122: Vec x, y;
123: PetscScalar sigma,*pV;
124: Mat A;
125: KSP ksp;
126: PC pc;
127:
130: VecGetLocalSize(eps->vec_initial,&n);
131: VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&x);
132: VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&y);
133: VecGetArray(eps->V[0],&pV);
134:
135: if (blz->slice) { STGetShift(eps->OP,&sigma); }
136: else sigma = 0.0; /* shift of origin */
137: nneig = 0; /* no. of eigs less than sigma */
139: blz->istor[0] = n; /* number of rows of U, V, X*/
140: blz->istor[1] = n; /* leading dimension of U, V, X */
141: blz->istor[2] = eps->nev; /* number of required eigenpairs */
142: blz->istor[3] = eps->ncv; /* number of working eigenpairs */
143: blz->istor[4] = blz->block_size; /* number of vectors in a block */
144: blz->istor[5] = blz->nsteps; /* maximun number of steps per run */
145: blz->istor[6] = 1; /* number of starting vectors as input */
146: blz->istor[7] = 0; /* number of eigenpairs given as input */
147: blz->istor[8] = blz->slice; /* problem type */
148: blz->istor[9] = blz->slice; /* spectrum slicing */
149: blz->istor[10] = blz->slice; /* solutions refinement (purify) */
150: blz->istor[11] = 0; /* level of printing */
151: blz->istor[12] = 6; /* file unit for output */
152: blz->istor[13] = MPI_Comm_c2f(eps->comm); /* communicator */
154: blz->rstor[0] = blz->initial; /* lower limit of eigenvalue interval */
155: blz->rstor[1] = blz->final; /* upper limit of eigenvalue interval */
156: blz->rstor[2] = eps->tol; /* threshold for convergence */
158: lflag = 0; /* reverse communication interface flag */
159: eps->its = 0;
161: do {
163: BLZpack_( blz->istor, blz->rstor, &sigma, &nneig, blz->u, blz->v,
164: &lflag, &nvopu, blz->eig, pV );
166: switch (lflag) {
167: case 1:
168: /* compute v = OP u */
169: for (i=0;i<nvopu;i++) {
170: VecPlaceArray( x, blz->u+i*n );
171: VecPlaceArray( y, blz->v+i*n );
172: if (blz->slice) {
173: STApplyNoB( eps->OP, x, y );
174: } else {
175: STApply( eps->OP, x, y );
176: }
177: EPSOrthogonalize(eps,eps->nds,eps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL);
178: }
179: /* monitor */
180: eps->its = eps->its + 1;
181: eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
182: EPSMonitor(eps,eps->its,eps->nconv,
183: blz->rstor+BLZistorr_(blz->istor,"IRITZ",5),
184: eps->eigi,
185: blz->rstor+BLZistorr_(blz->istor,"IRITZ",5)+BLZistorr_(blz->istor,"JT",2),
186: BLZistorr_(blz->istor,"NRITZ",5));
187: if (eps->its >= eps->max_it || eps->nconv >= eps->nev) lflag = 5;
188: break;
189: case 2:
190: /* compute v = B u */
191: for (i=0;i<nvopu;i++) {
192: VecPlaceArray( x, blz->u+i*n );
193: VecPlaceArray( y, blz->v+i*n );
194: STApplyB( eps->OP, x, y );
195: }
196: break;
197: case 3:
198: /* update shift */
199: STSetShift(eps->OP,sigma);
200: STGetKSP(eps->OP,&ksp);
201: KSPGetPC(ksp,&pc);
202: PCGetFactoredMatrix(pc,&A);
203: MatGetInertia(A,&nneig,PETSC_NULL,PETSC_NULL);
204: break;
205: case 4:
206: /* copy the initial vector */
207: VecPlaceArray(x,blz->v);
208: VecCopy(eps->vec_initial,x);
209: break;
210: }
211:
212: } while (lflag > 0);
214: VecRestoreArray( eps->V[0], &pV );
216: eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
217: eps->reason = EPS_CONVERGED_TOL;
219: for (i=0;i<eps->nconv;i++) {
220: eps->eigr[i]=blz->eig[i];
221: eps->eigi[i]=0.0;
222: }
224: if (lflag!=0) {
225: char msg[2048] = "";
226: for (i = 0; i < 33; i++) {
227: if (blz->istor[15] & (1 << i)) PetscStrcat(msg, blzpack_error[i]);
228: }
229: SETERRQ2(PETSC_ERR_LIB,"Error in BLZPACK (code=%d): '%s'",blz->istor[15], msg);
230: }
231: VecDestroy(x);
232: VecDestroy(y);
234: return(0);
235: }
239: PetscErrorCode EPSBackTransform_BLZPACK(EPS eps)
240: {
241: PetscErrorCode ierr;
242: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
245: if (!blz->slice) {
246: EPSBackTransform_Default(eps);
247: }
248: return(0);
249: }
253: PetscErrorCode EPSDestroy_BLZPACK(EPS eps)
254: {
255: PetscErrorCode ierr;
256: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
260: if (blz->istor) { PetscFree(blz->istor); }
261: if (blz->rstor) { PetscFree(blz->rstor); }
262: if (blz->u) { PetscFree(blz->u); }
263: if (blz->v) { PetscFree(blz->v); }
264: if (blz->eig) { PetscFree(blz->eig); }
265: if (eps->data) {PetscFree(eps->data);}
266: EPSFreeSolutionContiguous(eps);
267: return(0);
268: }
272: PetscErrorCode EPSView_BLZPACK(EPS eps,PetscViewer viewer)
273: {
274: PetscErrorCode ierr;
275: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
276: PetscTruth isascii;
279: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
280: if (!isascii) {
281: SETERRQ1(1,"Viewer type %s not supported for EPSBLZPACK",((PetscObject)viewer)->type_name);
282: }
283: PetscViewerASCIIPrintf(viewer,"block size of the block-Lanczos algorithm: %d\n",blz->block_size);
284: PetscViewerASCIIPrintf(viewer,"computational interval: [%f,%f]\n",blz->initial,blz->final);
285: return(0);
286: }
290: PetscErrorCode EPSSetFromOptions_BLZPACK(EPS eps)
291: {
292: PetscErrorCode ierr;
293: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
294: int bs,n;
295: PetscReal interval[2];
296: PetscTruth flg;
297: KSP ksp;
298: PC pc;
301: PetscOptionsHead("BLZPACK options");
303: bs = blz->block_size;
304: PetscOptionsInt("-eps_blzpack_block_size","Block size","EPSBlzpackSetBlockSize",bs,&bs,&flg);
305: if (flg) {EPSBlzpackSetBlockSize(eps,bs);}
307: n = blz->nsteps;
308: PetscOptionsInt("-eps_blzpack_nsteps","Number of steps","EPSBlzpackSetNSteps",n,&n,&flg);
309: if (flg) {EPSBlzpackSetNSteps(eps,n);}
311: interval[0] = blz->initial;
312: interval[1] = blz->final;
313: n = 2;
314: PetscOptionsRealArray("-eps_blzpack_interval","Computational interval","EPSBlzpackSetInterval",interval,&n,&flg);
315: if (flg) {
316: if (n==1) interval[1]=interval[0];
317: EPSBlzpackSetInterval(eps,interval[0],interval[1]);
318: }
320: if (blz->slice) {
321: STSetType(eps->OP,STSINV);
322: STGetKSP(eps->OP,&ksp);
323: KSPSetType(ksp,KSPPREONLY);
324: KSPGetPC(ksp,&pc);
325: PCSetType(pc,PCCHOLESKY);
326: }
328: PetscOptionsTail();
329: return(0);
330: }
332: EXTERN_C_BEGIN
335: PetscErrorCode EPSBlzpackSetBlockSize_BLZPACK(EPS eps,int bs)
336: {
337: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
340: if (bs == PETSC_DEFAULT) blz->block_size = 3;
341: else if (bs <= 0) {
342: SETERRQ(1, "Incorrect block size");
343: } else blz->block_size = bs;
344: return(0);
345: }
346: EXTERN_C_END
350: /*@
351: EPSBlzpackSetBlockSize - Sets the block size for the BLZPACK package.
353: Collective on EPS
355: Input Parameters:
356: + eps - the eigenproblem solver context
357: - bs - block size
359: Options Database Key:
360: . -eps_blzpack_block_size - Sets the value of the block size
362: Level: advanced
364: .seealso: EPSBlzpackSetInterval()
365: @*/
366: PetscErrorCode EPSBlzpackSetBlockSize(EPS eps,int bs)
367: {
368: PetscErrorCode ierr, (*f)(EPS,int);
372: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetBlockSize_C",(void (**)())&f);
373: if (f) {
374: (*f)(eps,bs);
375: }
376: return(0);
377: }
379: EXTERN_C_BEGIN
382: PetscErrorCode EPSBlzpackSetInterval_BLZPACK(EPS eps,PetscReal initial,PetscReal final)
383: {
384: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
387: blz->initial = initial;
388: blz->final = final;
389: blz->slice = 1;
390: return(0);
391: }
392: EXTERN_C_END
396: /*@
397: EPSBlzpackSetInterval - Sets the computational interval for the BLZPACK
398: package.
400: Collective on EPS
402: Input Parameters:
403: + eps - the eigenproblem solver context
404: . initial - lower bound of the interval
405: - final - upper bound of the interval
407: Options Database Key:
408: . -eps_blzpack_interval - Sets the bounds of the interval (two values
409: separated by commas)
411: Note:
412: The following possibilities are accepted (see Blzpack user's guide for
413: details).
414: initial>final: start seeking for eigenpairs in the upper bound
415: initial<final: start in the lower bound
416: initial=final: run around a single value (no interval)
417:
418: Level: advanced
420: .seealso: EPSBlzpackSetBlockSize()
421: @*/
422: PetscErrorCode EPSBlzpackSetInterval(EPS eps,PetscReal initial,PetscReal final)
423: {
424: PetscErrorCode ierr, (*f)(EPS,PetscReal,PetscReal);
428: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetInterval_C",(void (**)())&f);
429: if (f) {
430: (*f)(eps,initial,final);
431: }
432: return(0);
433: }
435: EXTERN_C_BEGIN
438: PetscErrorCode EPSBlzpackSetNSteps_BLZPACK(EPS eps,int nsteps)
439: {
440: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
443: blz->nsteps = nsteps == PETSC_DEFAULT ? 0 : nsteps;
444: return(0);
445: }
446: EXTERN_C_END
450: /*@
451: EPSBlzpackSetNSteps - Sets the maximum number of steps per run for the BLZPACK
452: package.
454: Collective on EPS
456: Input Parameters:
457: + eps - the eigenproblem solver context
458: - nsteps - maximum number of steps
460: Options Database Key:
461: . -eps_blzpack_nsteps - Sets the maximum number of steps per run
463: Level: advanced
465: @*/
466: PetscErrorCode EPSBlzpackSetNSteps(EPS eps,int nsteps)
467: {
468: PetscErrorCode ierr, (*f)(EPS,int);
472: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetNSteps_C",(void (**)())&f);
473: if (f) {
474: (*f)(eps,nsteps);
475: }
476: return(0);
477: }
479: EXTERN_C_BEGIN
482: PetscErrorCode EPSCreate_BLZPACK(EPS eps)
483: {
484: PetscErrorCode ierr;
485: EPS_BLZPACK *blzpack;
488: PetscNew(EPS_BLZPACK,&blzpack);
489: PetscMemzero(blzpack,sizeof(EPS_BLZPACK));
490: PetscLogObjectMemory(eps,sizeof(EPS_BLZPACK));
491: eps->data = (void *) blzpack;
492: eps->ops->solve = EPSSolve_BLZPACK;
493: eps->ops->setup = EPSSetUp_BLZPACK;
494: eps->ops->setfromoptions = EPSSetFromOptions_BLZPACK;
495: eps->ops->destroy = EPSDestroy_BLZPACK;
496: eps->ops->view = EPSView_BLZPACK;
497: eps->ops->backtransform = EPSBackTransform_BLZPACK;
498: eps->ops->computevectors = EPSComputeVectors_Default;
500: blzpack->block_size = 3;
501: blzpack->initial = 0.0;
502: blzpack->final = 0.0;
503: blzpack->slice = 0;
504: blzpack->nsteps = 0;
506: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetBlockSize_C","EPSBlzpackSetBlockSize_BLZPACK",EPSBlzpackSetBlockSize_BLZPACK);
507: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetInterval_C","EPSBlzpackSetInterval_BLZPACK",EPSBlzpackSetInterval_BLZPACK);
508: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetNSteps_C","EPSBlzpackSetNSteps_BLZPACK",EPSBlzpackSetNSteps_BLZPACK);
510: eps->which = EPS_SMALLEST_REAL;
512: return(0);
513: }
514: EXTERN_C_END