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