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: {
48: PetscInt N, n;
49: int listor, lrstor, ncuv, k1, k2, k3, k4;
50: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
51: PetscTruth flg;
52: KSP ksp;
53: PC pc;
56: VecGetSize(eps->vec_initial,&N);
57: VecGetLocalSize(eps->vec_initial,&n);
58: if (eps->ncv) {
59: if( eps->ncv < PetscMin(eps->nev+10,eps->nev*2) )
60: SETERRQ(0,"Warning: BLZpack recommends that ncv be larger than min(nev+10,nev*2)");
61: }
62: else eps->ncv = PetscMin(eps->nev+10,eps->nev*2);
63: if (!eps->max_it) eps->max_it = PetscMax(1000,N);
65: if (!eps->ishermitian)
66: SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
67: if (blz->slice) {
68: PetscTypeCompare((PetscObject)eps->OP,STSINV,&flg);
69: if (!flg)
70: SETERRQ(PETSC_ERR_SUP,"Shift-and-invert ST is needed for spectrum slicing");
71: STGetKSP(eps->OP,&ksp);
72: PetscTypeCompare((PetscObject)ksp,KSPPREONLY,&flg);
73: if (!flg)
74: SETERRQ(PETSC_ERR_SUP,"Preonly KSP is needed for spectrum slicing");
75: KSPGetPC(ksp,&pc);
76: PetscTypeCompare((PetscObject)pc,PCCHOLESKY,&flg);
77: if (!flg)
78: SETERRQ(PETSC_ERR_SUP,"Cholesky PC is needed for spectrum slicing");
79: }
80: if (eps->which!=EPS_SMALLEST_REAL)
81: SETERRQ(1,"Wrong value of eps->which");
83: k1 = PetscMin(N,180);
84: k2 = blz->block_size;
85: k4 = PetscMin(eps->ncv,N);
86: k3 = 484+k1*(13+k1*2+k2+PetscMax(18,k2+2))+k2*k2*3+k4*2;
88: listor = 123+k1*12;
89: PetscFree(blz->istor);
90: PetscMalloc((17+listor)*sizeof(int),&blz->istor);
91: blz->istor[14] = listor;
93: if (blz->slice) lrstor = n*(k2*4+k1*2+k4)+k3;
94: else lrstor = n*(k2*4+k1)+k3;
95: PetscFree(blz->rstor);
96: PetscMalloc((4+lrstor)*sizeof(PetscReal),&blz->rstor);
97: blz->rstor[3] = lrstor;
99: ncuv = PetscMax(3,blz->block_size);
100: PetscFree(blz->u);
101: PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->u);
102: PetscFree(blz->v);
103: PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->v);
105: PetscFree(blz->eig);
106: PetscMalloc(2*eps->ncv*sizeof(PetscReal),&blz->eig);
108: EPSAllocateSolutionContiguous(eps);
109: return(0);
110: }
114: PetscErrorCode EPSSolve_BLZPACK(EPS eps)
115: {
117: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
118: PetscInt n, nn;
119: int i, nneig, lflag, nvopu;
120: Vec x, y;
121: PetscScalar sigma,*pV;
122: Mat A;
123: KSP ksp;
124: PC pc;
125:
128: VecGetLocalSize(eps->vec_initial,&n);
129: VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&x);
130: VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&y);
131: VecGetArray(eps->V[0],&pV);
132:
133: if (blz->slice) { STGetShift(eps->OP,&sigma); }
134: else sigma = 0.0; /* shift of origin */
135: nneig = 0; /* no. of eigs less than sigma */
137: blz->istor[0] = n; /* number of rows of U, V, X*/
138: blz->istor[1] = n; /* leading dimension of U, V, X */
139: blz->istor[2] = eps->nev; /* number of required eigenpairs */
140: blz->istor[3] = eps->ncv; /* number of working eigenpairs */
141: blz->istor[4] = blz->block_size; /* number of vectors in a block */
142: blz->istor[5] = blz->nsteps; /* maximun number of steps per run */
143: blz->istor[6] = 1; /* number of starting vectors as input */
144: blz->istor[7] = 0; /* number of eigenpairs given as input */
145: blz->istor[8] = blz->slice; /* problem type */
146: blz->istor[9] = blz->slice; /* spectrum slicing */
147: blz->istor[10] = blz->slice; /* solutions refinement (purify) */
148: blz->istor[11] = 0; /* level of printing */
149: blz->istor[12] = 6; /* file unit for output */
150: blz->istor[13] = MPI_Comm_c2f(eps->comm); /* communicator */
152: blz->rstor[0] = blz->initial; /* lower limit of eigenvalue interval */
153: blz->rstor[1] = blz->final; /* upper limit of eigenvalue interval */
154: blz->rstor[2] = eps->tol; /* threshold for convergence */
156: lflag = 0; /* reverse communication interface flag */
158: do {
160: BLZpack_( blz->istor, blz->rstor, &sigma, &nneig, blz->u, blz->v,
161: &lflag, &nvopu, blz->eig, pV );
163: switch (lflag) {
164: case 1:
165: /* compute v = OP u */
166: for (i=0;i<nvopu;i++) {
167: VecPlaceArray( x, blz->u+i*n );
168: VecPlaceArray( y, blz->v+i*n );
169: if (blz->slice) {
170: STApplyNoB( eps->OP, x, y );
171: } else {
172: STApply( eps->OP, x, y );
173: }
174: EPSOrthogonalize(eps,eps->nds,PETSC_NULL,eps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL);
175: VecResetArray(x);
176: VecResetArray(y);
177: }
178: /* monitor */
179: eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
180: EPSMonitor(eps,eps->its,eps->nconv,
181: blz->rstor+BLZistorr_(blz->istor,"IRITZ",5),
182: eps->eigi,
183: blz->rstor+BLZistorr_(blz->istor,"IRITZ",5)+BLZistorr_(blz->istor,"JT",2),
184: BLZistorr_(blz->istor,"NRITZ",5));
185: eps->its = eps->its + 1;
186: if (eps->its >= eps->max_it || eps->nconv >= eps->nev) lflag = 5;
187: break;
188: case 2:
189: /* compute v = B u */
190: for (i=0;i<nvopu;i++) {
191: VecPlaceArray( x, blz->u+i*n );
192: VecPlaceArray( y, blz->v+i*n );
193: STApplyB( eps->OP, x, y );
194: VecResetArray(x);
195: VecResetArray(y);
196: }
197: break;
198: case 3:
199: /* update shift */
200: STSetShift(eps->OP,sigma);
201: STGetKSP(eps->OP,&ksp);
202: KSPGetPC(ksp,&pc);
203: PCGetFactoredMatrix(pc,&A);
204: MatGetInertia(A,&nn,PETSC_NULL,PETSC_NULL);
205: nneig = nn;
206: break;
207: case 4:
208: /* copy the initial vector */
209: VecPlaceArray(x,blz->v);
210: VecCopy(eps->vec_initial,x);
211: VecResetArray(x);
212: break;
213: }
214:
215: } while (lflag > 0);
217: VecRestoreArray( eps->V[0], &pV );
219: eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
220: eps->reason = EPS_CONVERGED_TOL;
222: for (i=0;i<eps->nconv;i++) {
223: eps->eigr[i]=blz->eig[i];
224: }
226: if (lflag!=0) {
227: char msg[2048] = "";
228: for (i = 0; i < 33; i++) {
229: if (blz->istor[15] & (1 << i)) PetscStrcat(msg, blzpack_error[i]);
230: }
231: SETERRQ2(PETSC_ERR_LIB,"Error in BLZPACK (code=%d): '%s'",blz->istor[15], msg);
232: }
233: VecDestroy(x);
234: VecDestroy(y);
236: return(0);
237: }
241: PetscErrorCode EPSBackTransform_BLZPACK(EPS eps)
242: {
244: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
247: if (!blz->slice) {
248: EPSBackTransform_Default(eps);
249: }
250: return(0);
251: }
255: PetscErrorCode EPSDestroy_BLZPACK(EPS eps)
256: {
258: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
262: PetscFree(blz->istor);
263: PetscFree(blz->rstor);
264: PetscFree(blz->u);
265: PetscFree(blz->v);
266: PetscFree(blz->eig);
267: PetscFree(eps->data);
268: EPSFreeSolutionContiguous(eps);
269: return(0);
270: }
274: PetscErrorCode EPSView_BLZPACK(EPS eps,PetscViewer viewer)
275: {
277: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
278: PetscTruth isascii;
281: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
282: if (!isascii) {
283: SETERRQ1(1,"Viewer type %s not supported for EPSBLZPACK",((PetscObject)viewer)->type_name);
284: }
285: PetscViewerASCIIPrintf(viewer,"block size of the block-Lanczos algorithm: %d\n",blz->block_size);
286: PetscViewerASCIIPrintf(viewer,"computational interval: [%f,%f]\n",blz->initial,blz->final);
287: return(0);
288: }
292: PetscErrorCode EPSSetFromOptions_BLZPACK(EPS eps)
293: {
295: EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
296: PetscInt bs,n;
297: PetscReal interval[2];
298: PetscTruth flg;
299: KSP ksp;
300: PC pc;
303: PetscOptionsHead("BLZPACK options");
305: bs = blz->block_size;
306: PetscOptionsInt("-eps_blzpack_block_size","Block size","EPSBlzpackSetBlockSize",bs,&bs,&flg);
307: if (flg) {EPSBlzpackSetBlockSize(eps,bs);}
309: n = blz->nsteps;
310: PetscOptionsInt("-eps_blzpack_nsteps","Number of steps","EPSBlzpackSetNSteps",n,&n,&flg);
311: if (flg) {EPSBlzpackSetNSteps(eps,n);}
313: interval[0] = blz->initial;
314: interval[1] = blz->final;
315: n = 2;
316: PetscOptionsRealArray("-eps_blzpack_interval","Computational interval","EPSBlzpackSetInterval",interval,&n,&flg);
317: if (flg) {
318: if (n==1) interval[1]=interval[0];
319: EPSBlzpackSetInterval(eps,interval[0],interval[1]);
320: }
322: if (blz->slice) {
323: STSetType(eps->OP,STSINV);
324: STGetKSP(eps->OP,&ksp);
325: KSPSetType(ksp,KSPPREONLY);
326: KSPGetPC(ksp,&pc);
327: PCSetType(pc,PCCHOLESKY);
328: }
330: PetscOptionsTail();
331: return(0);
332: }
337: PetscErrorCode EPSBlzpackSetBlockSize_BLZPACK(EPS eps,int bs)
338: {
339: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
342: if (bs == PETSC_DEFAULT) blz->block_size = 3;
343: else if (bs <= 0) {
344: SETERRQ(1, "Incorrect block size");
345: } else blz->block_size = bs;
346: return(0);
347: }
352: /*@
353: EPSBlzpackSetBlockSize - Sets the block size for the BLZPACK package.
355: Collective on EPS
357: Input Parameters:
358: + eps - the eigenproblem solver context
359: - bs - block size
361: Options Database Key:
362: . -eps_blzpack_block_size - Sets the value of the block size
364: Level: advanced
366: .seealso: EPSBlzpackSetInterval()
367: @*/
368: PetscErrorCode EPSBlzpackSetBlockSize(EPS eps,int bs)
369: {
370: PetscErrorCode ierr, (*f)(EPS,int);
374: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetBlockSize_C",(void (**)())&f);
375: if (f) {
376: (*f)(eps,bs);
377: }
378: return(0);
379: }
384: PetscErrorCode EPSBlzpackSetInterval_BLZPACK(EPS eps,PetscReal initial,PetscReal final)
385: {
386: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
389: blz->initial = initial;
390: blz->final = final;
391: blz->slice = 1;
392: return(0);
393: }
398: /*@
399: EPSBlzpackSetInterval - Sets the computational interval for the BLZPACK
400: package.
402: Collective on EPS
404: Input Parameters:
405: + eps - the eigenproblem solver context
406: . initial - lower bound of the interval
407: - final - upper bound of the interval
409: Options Database Key:
410: . -eps_blzpack_interval - Sets the bounds of the interval (two values
411: separated by commas)
413: Note:
414: The following possibilities are accepted (see Blzpack user's guide for
415: details).
416: initial>final: start seeking for eigenpairs in the upper bound
417: initial<final: start in the lower bound
418: initial=final: run around a single value (no interval)
419:
420: Level: advanced
422: .seealso: EPSBlzpackSetBlockSize()
423: @*/
424: PetscErrorCode EPSBlzpackSetInterval(EPS eps,PetscReal initial,PetscReal final)
425: {
426: PetscErrorCode ierr, (*f)(EPS,PetscReal,PetscReal);
430: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetInterval_C",(void (**)())&f);
431: if (f) {
432: (*f)(eps,initial,final);
433: }
434: return(0);
435: }
440: PetscErrorCode EPSBlzpackSetNSteps_BLZPACK(EPS eps,int nsteps)
441: {
442: EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
445: blz->nsteps = nsteps == PETSC_DEFAULT ? 0 : nsteps;
446: return(0);
447: }
452: /*@
453: EPSBlzpackSetNSteps - Sets the maximum number of steps per run for the BLZPACK
454: package.
456: Collective on EPS
458: Input Parameters:
459: + eps - the eigenproblem solver context
460: - nsteps - maximum number of steps
462: Options Database Key:
463: . -eps_blzpack_nsteps - Sets the maximum number of steps per run
465: Level: advanced
467: @*/
468: PetscErrorCode EPSBlzpackSetNSteps(EPS eps,int nsteps)
469: {
470: PetscErrorCode ierr, (*f)(EPS,int);
474: PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetNSteps_C",(void (**)())&f);
475: if (f) {
476: (*f)(eps,nsteps);
477: }
478: return(0);
479: }
484: PetscErrorCode EPSCreate_BLZPACK(EPS eps)
485: {
487: EPS_BLZPACK *blzpack;
490: PetscNew(EPS_BLZPACK,&blzpack);
491: PetscLogObjectMemory(eps,sizeof(EPS_BLZPACK));
492: eps->data = (void *) blzpack;
493: eps->ops->solve = EPSSolve_BLZPACK;
494: eps->ops->setup = EPSSetUp_BLZPACK;
495: eps->ops->setfromoptions = EPSSetFromOptions_BLZPACK;
496: eps->ops->destroy = EPSDestroy_BLZPACK;
497: eps->ops->view = EPSView_BLZPACK;
498: eps->ops->backtransform = EPSBackTransform_BLZPACK;
499: eps->ops->computevectors = EPSComputeVectors_Default;
501: blzpack->block_size = 3;
502: blzpack->initial = 0.0;
503: blzpack->final = 0.0;
504: blzpack->slice = 0;
505: blzpack->nsteps = 0;
507: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetBlockSize_C","EPSBlzpackSetBlockSize_BLZPACK",EPSBlzpackSetBlockSize_BLZPACK);
508: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetInterval_C","EPSBlzpackSetInterval_BLZPACK",EPSBlzpackSetInterval_BLZPACK);
509: PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetNSteps_C","EPSBlzpackSetNSteps_BLZPACK",EPSBlzpackSetNSteps_BLZPACK);
511: eps->which = EPS_SMALLEST_REAL;
513: return(0);
514: }