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: }