Actual source code: dvd_utils.c

  1: /*
  2:   SLEPc eigensolver: "davidson"

  4:   Some utils

  6:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  7:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  8:    Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain

 10:    This file is part of SLEPc.
 11:       
 12:    SLEPc is free software: you can redistribute it and/or modify it under  the
 13:    terms of version 3 of the GNU Lesser General Public License as published by
 14:    the Free Software Foundation.

 16:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY 
 17:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS 
 18:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for 
 19:    more details.

 21:    You  should have received a copy of the GNU Lesser General  Public  License
 22:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
 23:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 24: */

 26:  #include davidson.h

 28: PetscErrorCode dvd_static_precond_PC_0(dvdDashboard *d, PetscInt i, Vec x,
 29:                                        Vec Px);
 30: PetscErrorCode dvd_jacobi_precond_0(dvdDashboard *d, PetscInt i, Vec x, Vec Px);
 31: PetscErrorCode dvd_precond_none(dvdDashboard *d, PetscInt i, Vec x, Vec Px);
 32: PetscErrorCode dvd_improvex_precond_d(dvdDashboard *d);

 34: typedef struct {
 35:   PC pc;
 36: } dvdPCWrapper;
 37: /*
 38:   Create a static preconditioner from a PC
 39: */
 42: PetscErrorCode dvd_static_precond_PC(dvdDashboard *d, dvdBlackboard *b, PC pc)
 43: {
 44:   PetscErrorCode  ierr;
 45:   dvdPCWrapper    *dvdpc;
 46:   Mat             P;
 47:   MatStructure    str;


 51:   /* Setup the step */
 52:   if (b->state >= DVD_STATE_CONF) {
 53:     /* If the preconditioner is valid */
 54:     if (pc) {
 55:       PetscMalloc(sizeof(dvdPCWrapper), &dvdpc);
 56:       dvdpc->pc = pc;
 57:       PetscObjectReference((PetscObject)pc);
 58:       d->improvex_precond_data = dvdpc;
 59:       d->improvex_precond = dvd_static_precond_PC_0;

 61:       /* PC saves the matrix associated with the linear system, and it has to
 62:          be initialize to a valid matrix */
 63:       PCGetOperators(pc, PETSC_NULL, &P, &str);
 64:       PetscObjectReference((PetscObject)P);
 65:       PCSetOperators(pc, P, P, str);
 66:       MatDestroy(P);
 67:       PCSetUp(pc);

 69:       DVD_FL_ADD(d->destroyList, dvd_improvex_precond_d);

 71:     /* Else, use no preconditioner */
 72:     } else
 73:       d->improvex_precond = dvd_precond_none;
 74:   }

 76:   return(0);
 77: }

 81: PetscErrorCode dvd_improvex_precond_d(dvdDashboard *d)
 82: {
 83:   PetscErrorCode  ierr;
 84:   dvdPCWrapper    *dvdpc = (dvdPCWrapper*)d->improvex_precond_data;


 88:   /* Free local data */
 89:   if (dvdpc->pc) { PCDestroy(dvdpc->pc);  }
 90:   PetscFree(d->improvex_precond_data);
 91:   d->improvex_precond_data = PETSC_NULL;

 93:   return(0);
 94: }


 97: PetscErrorCode dvd_static_precond_PC_0(dvdDashboard *d, PetscInt i, Vec x,
 98:                                        Vec Px)
 99: {
100:   PetscErrorCode  ierr;
101:   dvdPCWrapper    *dvdpc = (dvdPCWrapper*)d->improvex_precond_data;


105:   PCApply(dvdpc->pc, x, Px);
106: 
107:   return(0);
108: }

110: typedef struct {
111:   Vec diagA, diagB;
112: } dvdJacobiPrecond;
113: /*
114:   Create the Jacobi preconditioner for Generalized Eigenproblems
115: */
116: PetscErrorCode dvd_jacobi_precond(dvdDashboard *d, dvdBlackboard *b)
117: {
118:   PetscErrorCode  ierr;
119:   dvdJacobiPrecond
120:                   *dvdjp;
121:   PetscTruth      t;


125:   /* Check if the problem matrices support GetDiagonal */
126:   MatHasOperation(d->A, MATOP_GET_DIAGONAL, &t);
127:   if (t && d->B) {
128:     MatHasOperation(d->B, MATOP_GET_DIAGONAL, &t);
129:   }

131:   /* Setting configuration constrains */
132:   b->own_vecs+= t?( (d->B == 0)?1:2 ) : 0;

134:   /* Setup the step */
135:   if (b->state >= DVD_STATE_CONF) {
136:     if (t) {
137:       PetscMalloc(sizeof(dvdJacobiPrecond), &dvdjp);
138:       dvdjp->diagA = *b->free_vecs; b->free_vecs++;
139:       MatGetDiagonal(d->A,dvdjp->diagA);
140:       if (d->B) {
141:         dvdjp->diagB = *b->free_vecs; b->free_vecs++;
142:         MatGetDiagonal(d->B, dvdjp->diagB);
143:       } else
144:         dvdjp->diagB = 0;
145:       d->improvex_precond_data = dvdjp;
146:       d->improvex_precond = dvd_jacobi_precond_0;

148:       DVD_FL_ADD(d->destroyList, dvd_improvex_precond_d);

150:     /* Else, use no preconditioner */
151:     } else
152:       d->improvex_precond = dvd_precond_none;
153:   }

155:   return(0);
156: }

158: PetscErrorCode dvd_jacobi_precond_0(dvdDashboard *d, PetscInt i, Vec x, Vec Px)
159: {
160:   PetscErrorCode  ierr;
161:   dvdJacobiPrecond
162:                   *dvdjp = (dvdJacobiPrecond*)d->improvex_precond_data;


166:   /* Compute inv(D - eig)*x */
167:   if (dvdjp->diagB == 0) {
168:     /* Px <- diagA - l */
169:     VecCopy(dvdjp->diagA, Px);
170:     VecShift(Px, -d->eigr[i]);
171:   } else {
172:     /* Px <- diagA - l*diagB */
173:     VecWAXPY(Px, -d->eigr[i], dvdjp->diagB, dvdjp->diagA);
174: 
175:   }

177:   /* Px(i) <- x/Px(i) */
178:   VecPointwiseDivide(Px, x, Px);

180:   return(0);
181: }

183: /*
184:   Create a trivial preconditioner
185: */
186: PetscErrorCode dvd_precond_none(dvdDashboard *d, PetscInt i, Vec x, Vec Px)
187: {
188:   PetscErrorCode  ierr;


192:   VecCopy(x, Px);

194:   return(0);
195: }


198: /*
199:   Use of PETSc profiler functions
200: */

202: /* Define stages */
203: #define DVD_STAGE_INITV 0 
204: #define DVD_STAGE_NEWITER 1 
205: #define DVD_STAGE_CALCPAIRS 2 
206: #define DVD_STAGE_IMPROVEX 3
207: #define DVD_STAGE_UPDATEV 4
208: #define DVD_STAGE_ORTHV 5

210: PetscErrorCode dvd_profiler_d(dvdDashboard *d);

212: typedef struct {
213:   PetscErrorCode (*old_initV)(struct _dvdDashboard*);
214:   PetscErrorCode (*old_calcPairs)(struct _dvdDashboard*);
215:   PetscErrorCode (*old_improveX)(struct _dvdDashboard*, Vec *D,
216:                                  PetscInt max_size_D, PetscInt r_s,
217:                                  PetscInt r_e, PetscInt *size_D);
218:   PetscErrorCode (*old_updateV)(struct _dvdDashboard*);
219:   PetscErrorCode (*old_orthV)(struct _dvdDashboard*);
220: } DvdProfiler;

222: PetscLogStage stages[6] = {0,0,0,0,0,0};

224: /*** Other things ****/

228: PetscErrorCode dvd_prof_init() {
229:   PetscErrorCode  ierr;


233:   if (!stages[0]) {
234:     PetscLogStageRegister("Dvd_step_initV", &stages[DVD_STAGE_INITV]);
235: 
236:     PetscLogStageRegister("Dvd_step_calcPairs",
237:                                  &stages[DVD_STAGE_CALCPAIRS]);
238:     PetscLogStageRegister("Dvd_step_improveX",
239:                                  &stages[DVD_STAGE_IMPROVEX]);
240:     PetscLogStageRegister("Dvd_step_updateV",
241:                                  &stages[DVD_STAGE_UPDATEV]);
242:     PetscLogStageRegister("Dvd_step_orthV",
243:                                  &stages[DVD_STAGE_ORTHV]);
244:   }
245: 
246:   return(0);
247: }

249: PetscErrorCode dvd_initV_prof(dvdDashboard* d) {
250:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;
251:   PetscErrorCode  ierr;


255:   PetscLogStagePush(stages[DVD_STAGE_INITV]);
256:   p->old_initV(d);
257:   PetscLogStagePop();

259:   return(0);
260: }

262: PetscErrorCode dvd_calcPairs_prof(dvdDashboard* d) {
263:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;
264:   PetscErrorCode  ierr;


268:   PetscLogStagePush(stages[DVD_STAGE_CALCPAIRS]);
269:   p->old_calcPairs(d);
270:   PetscLogStagePop();

272:   return(0);
273: }

275: PetscErrorCode dvd_improveX_prof(dvdDashboard* d, Vec *D, PetscInt max_size_D,
276:                        PetscInt r_s, PetscInt r_e, PetscInt *size_D) {
277:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;
278:   PetscErrorCode  ierr;


282:   PetscLogStagePush(stages[DVD_STAGE_IMPROVEX]);
283:   p->old_improveX(d, D, max_size_D, r_s, r_e, size_D);
284:   PetscLogStagePop();

286:   return(0);
287: }

289: PetscErrorCode dvd_updateV_prof(dvdDashboard *d) {
290:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;
291:   PetscErrorCode  ierr;


295:   PetscLogStagePush(stages[DVD_STAGE_UPDATEV]);
296:   p->old_updateV(d);
297:   PetscLogStagePop();

299:   return(0);
300: }

302: PetscErrorCode dvd_orthV_prof(dvdDashboard *d) {
303:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;
304:   PetscErrorCode  ierr;


308:   PetscLogStagePush(stages[DVD_STAGE_ORTHV]);
309:   p->old_orthV(d);
310:   PetscLogStagePop();

312:   return(0);
313: }

317: PetscErrorCode dvd_profiler(dvdDashboard *d, dvdBlackboard *b)
318: {
319:   PetscErrorCode  ierr;
320:   DvdProfiler     *p;


324:   /* Setup the step */
325:   if (b->state >= DVD_STATE_CONF) {
326:     if (d->prof_data) {
327:       PetscFree(d->prof_data);
328:     }
329:     PetscMalloc(sizeof(DvdProfiler), &p);
330:     d->prof_data = p;
331:     p->old_initV = d->initV; d->initV = dvd_initV_prof;
332:     p->old_calcPairs = d->calcPairs; d->calcPairs = dvd_calcPairs_prof;
333:     p->old_improveX = d->improveX; d->improveX = dvd_improveX_prof;
334:     p->old_updateV = d->updateV; d->updateV = dvd_updateV_prof;

336:     DVD_FL_ADD(d->destroyList, dvd_profiler_d);
337:   }

339:   return(0);
340: }

344: PetscErrorCode dvd_profiler_d(dvdDashboard *d)
345: {
346:   PetscErrorCode  ierr;
347:   DvdProfiler     *p = (DvdProfiler*)d->prof_data;


351:   /* Free local data */
352:   PetscFree(p);
353:   d->prof_data = PETSC_NULL;

355:   return(0);
356: }



360: /*
361:   Configure the harmonics.
362:   switch(mode) {
363:   DVD_HARM_RR:    harmonic RR
364:   DVD_HARM_RRR:   relative harmonic RR
365:   DVD_HARM_REIGS: rightmost eigenvalues
366:   DVD_HARM_LEIGS: largest eigenvalues
367:   }
368:   fixedTarged, if true use the target instead of the best eigenvalue
369:   target, the fixed target to be used
370: */
371: typedef struct {
372:   PetscScalar
373:     Wa, Wb,       /* span{W} = span{Wa*AV - Wb*BV} */
374:     Pa, Pb;       /* H=W'*(Pa*AV - Pb*BV), G=W'*(Wa*AV - Wb*BV) */
375:   PetscTruth
376:     withTarget;
377:   HarmType_t
378:     mode;

380:   /* old values of eps */
381:   EPSWhich
382:     old_which;
383:   PetscErrorCode
384:     (*old_which_func)(EPS,PetscScalar,PetscScalar,PetscScalar,PetscScalar,
385:                       PetscInt*,void*);
386:   void
387:     *old_which_ctx;
388: } dvdHarmonic;

390: PetscErrorCode dvd_harm_start(dvdDashboard *d);
391: PetscErrorCode dvd_harm_end(dvdDashboard *d);
392: PetscErrorCode dvd_harm_d(dvdDashboard *d);
393: PetscErrorCode dvd_harm_transf(dvdHarmonic *dvdh, PetscScalar t);
394: PetscErrorCode dvd_harm_updateW(dvdDashboard *d);
395: PetscErrorCode dvd_harm_proj(dvdDashboard *d);
396: PetscErrorCode dvd_harm_sort(EPS eps, PetscScalar ar, PetscScalar ai,
397:                              PetscScalar br, PetscScalar bi, PetscInt *r,
398:                              void *ctx);
399: PetscErrorCode dvd_harm_eigs_trans(dvdDashboard *d);

401: PetscErrorCode dvd_harm_conf(dvdDashboard *d, dvdBlackboard *b,
402:                              HarmType_t mode, PetscTruth fixedTarget,
403:                              PetscScalar t)
404: {
405:   PetscErrorCode  ierr;
406:   dvdHarmonic     *dvdh;


410:   /* Set the problem to GNHEP */
411:   // TODO: d->G maybe is upper triangular due to biorthogonality of V and W
412:   d->sEP = d->sA = d->sB = 0;

414:   /* Setup the step */
415:   if (b->state >= DVD_STATE_CONF) {
416:     PetscMalloc(sizeof(dvdHarmonic), &dvdh);
417:     dvdh->withTarget = fixedTarget;
418:     dvdh->mode = mode;
419:     if (fixedTarget) dvd_harm_transf(dvdh, t);
420:     d->calcpairs_W_data = dvdh;
421:     d->calcpairs_W = dvd_harm_updateW;
422:     d->calcpairs_proj_trans = dvd_harm_proj;
423:     d->calcpairs_eigs_trans = dvd_harm_eigs_trans;

425:     DVD_FL_ADD(d->startList, dvd_harm_start);
426:     DVD_FL_ADD(d->endList, dvd_harm_end);
427:     DVD_FL_ADD(d->destroyList, dvd_harm_d);
428:   }

430:   return(0);
431: }


436: PetscErrorCode dvd_harm_d(dvdDashboard *d)
437: {
438:   PetscErrorCode  ierr;


442:   /* Free local data */
443:   PetscFree(d->calcpairs_W_data);
444:   d->calcpairs_W_data = PETSC_NULL;

446:   return(0);
447: }


452: PetscErrorCode dvd_harm_start(dvdDashboard *d)
453: {
454:   dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;


458:   /* Overload the eigenpairs selection routine */
459:   data->old_which = d->eps->which;
460:   data->old_which_func = d->eps->which_func;
461:   data->old_which_ctx = d->eps->which_ctx;
462:   d->eps->which = EPS_WHICH_USER;
463:   d->eps->which_func = dvd_harm_sort;
464:   d->eps->which_ctx = data;

466:   return(0);
467: }


472: PetscErrorCode dvd_harm_end(dvdDashboard *d)
473: {
474:   dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;


478:   /* Restore the eigenpairs selection routine */
479:   d->eps->which = data->old_which;
480:   d->eps->which_func = data->old_which_func;
481:   d->eps->which_ctx = data->old_which_ctx;

483:   return(0);
484: }


487: PetscErrorCode dvd_harm_transf(dvdHarmonic *dvdh, PetscScalar t)
488: {

491:   switch(dvdh->mode) {
492:   case DVD_HARM_RR:    /* harmonic RR */
493:     dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 0.0; dvdh->Pb = -1.0; break;
494:   case DVD_HARM_RRR:   /* relative harmonic RR */
495:     dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 1.0; dvdh->Pb = 0.0; break;
496:   case DVD_HARM_REIGS: /* rightmost eigenvalues */
497:     dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 1.0; dvdh->Pb = -PetscConj(t);
498:     break;
499:   case DVD_HARM_LEIGS: /* largest eigenvalues */
500:     dvdh->Wa = 0.0; dvdh->Wb = 1.0; dvdh->Pa = 1.0; dvdh->Pb = 0.0; break;
501:   case DVD_HARM_NONE:
502:   default:
503:     SETERRQ(1, "The harmonic type is not supported!");
504:   }

506:   /* Check the transformation does not change the sign of the imaginary part */
507: #if !defined(PETSC_USE_COMPLEX)
508:   if (dvdh->Pb*dvdh->Wa - dvdh->Wb*dvdh->Pa < 0.0)
509:     dvdh->Pa*= -1.0, dvdh->Pb*= -1.0;
510: #endif

512:   return(0);
513: }

515: PetscErrorCode dvd_harm_updateW(dvdDashboard *d)
516: {
517:   dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
518:   PetscErrorCode  ierr;
519:   PetscInt        i;


523:   /* Update the target if it is necessary */
524:   if (!data->withTarget) dvd_harm_transf(data, d->eigr[0]);
525: 
526:   for(i=d->V_new_s; i<d->V_new_e; i++) {
527:     /* W(i) <- Wa*AV(i) - Wb*BV(i) */
528:     VecCopy(d->AV[i], d->W[i]);
529:     VecAXPBY(d->W[i], -data->Wb, data->Wa, (d->BV?d->BV:d->V)[i]);
530: 
531:   }

533:   return(0);
534: }

536: PetscErrorCode dvd_harm_proj(dvdDashboard *d)
537: {
538:   dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
539:   PetscInt        i,j;


543:   if (d->sH != d->sG) {
544:     SETERRQ(1, "Error: Projected matrices H and G must have the same structure!");
545:     PetscFunctionReturn(1);
546:   }

548:   /* [H G] <- [Pa*H - Pb*G, Wa*H - Wb*G] */
549:   if (DVD_ISNOT(d->sH,DVD_MAT_LTRIANG))     /* Upper triangular part */
550:     for(i=d->V_new_s; i<d->V_new_e; i++)
551:       for(j=0; j<=i; j++) {
552:         PetscScalar h = d->H[d->ldH*i+j], g = d->G[d->ldH*i+j];
553:         d->H[d->ldH*i+j] = data->Pa*h - data->Pb*g;
554:         d->G[d->ldH*i+j] = data->Wa*h - data->Wb*g;
555:       }
556:   if (DVD_ISNOT(d->sH,DVD_MAT_UTRIANG))     /* Lower triangular part */
557:     for(i=0; i<d->V_new_e; i++)
558:       for(j=PetscMax(d->V_new_s,i+(DVD_ISNOT(d->sH,DVD_MAT_LTRIANG)?1:0));
559:           j<d->V_new_e; j++) {
560:         PetscScalar h = d->H[d->ldH*i+j], g = d->G[d->ldH*i+j];
561:         d->H[d->ldH*i+j] = data->Pa*h - data->Pb*g;
562:         d->G[d->ldH*i+j] = data->Wa*h - data->Wb*g;
563:       }

565:   return(0);
566: }

568: PetscErrorCode dvd_harm_backtrans(dvdHarmonic *data, PetscScalar *ar,
569:                                   PetscScalar *ai)
570: {
571:   PetscScalar xr;
572: #if !defined(PETSC_USE_COMPLEX)
573:   PetscScalar xi, k;
574: #endif


578:   if(!ar) SETERRQ(1, "The real part has to be present!");
579:   xr = *ar;

581: #if !defined(PETSC_USE_COMPLEX)
582:   if(!ai) SETERRQ(1, "The imaginary part has to be present!");
583:   xi = *ai;

585:   if (xi != 0.0) {
586:     k = (data->Pa - data->Wa*xr)*(data->Pa - data->Wa*xr) +
587:         data->Wa*data->Wa*xi*xi;
588:     *ar = (data->Pb*data->Pa - (data->Pb*data->Wa + data->Wb*data->Pa)*xr +
589:            data->Wb*data->Wa*(xr*xr + xi*xi))/k;
590:     *ai = (data->Pb*data->Wa - data->Wb*data->Pa)*xi/k;
591:   } else
592: #endif
593:     *ar = (data->Pb - data->Wb*xr) / (data->Pa - data->Wa*xr);

595:   return(0);
596: }


599: PetscErrorCode dvd_harm_sort(EPS eps, PetscScalar ar, PetscScalar ai,
600:                              PetscScalar br, PetscScalar bi, PetscInt *r,
601:                              void *ctx)
602: {
603:   dvdHarmonic     *data = (dvdHarmonic*)ctx;
604:   PetscErrorCode  ierr;


608:   /* Back-transform the harmonic values */
609:   dvd_harm_backtrans(data, &ar, &ai);
610:   dvd_harm_backtrans(data, &br, &bi);

612:   /* Compare values using the user options for the eigenpairs selection */
613:   eps->which = data->old_which;
614:   eps->which_func = data->old_which_func;
615:   eps->which_ctx = data->old_which_ctx;
616:   EPSCompareEigenvalues(eps, ar, ai, br, bi, r);

618:   /* Restore the eps values */
619:   eps->which = EPS_WHICH_USER;
620:   eps->which_func = dvd_harm_sort;
621:   eps->which_ctx = data;

623:   return(0);
624: }

626: PetscErrorCode dvd_harm_eigs_trans(dvdDashboard *d)
627: {
628:   dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
629:   PetscInt        i;


633:   for(i=0; i<d->size_H; i++)
634:     dvd_harm_backtrans(data, &d->eigr[i], &d->eigi[i]);

636:   return(0);
637: }