Subversion Repositories slepc-dev

Rev

Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1619 slepc 1
/*
2
  SLEPc eigensolver: "davidson"
3
 
4
  Some utils
5
 
2110 jroman 6
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
7
   SLEPc - Scalable Library for Eigenvalue Problem Computations
2575 eromero 8
   Copyright (c) 2002-2011, Universitat Politecnica de Valencia, Spain
2110 jroman 9
 
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.
15
 
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.
20
 
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
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1619 slepc 24
*/
25
 
1985 eromero 26
#include "davidson.h"
1619 slepc 27
 
1764 eromero 28
PetscErrorCode dvd_static_precond_PC_0(dvdDashboard *d, PetscInt i, Vec x,
29
                                       Vec Px);
1736 eromero 30
PetscErrorCode dvd_jacobi_precond_0(dvdDashboard *d, PetscInt i, Vec x, Vec Px);
1883 eromero 31
PetscErrorCode dvd_precond_none(dvdDashboard *d, PetscInt i, Vec x, Vec Px);
2021 eromero 32
PetscErrorCode dvd_improvex_precond_d(dvdDashboard *d);
1619 slepc 33
 
34
typedef struct {
35
  PC pc;
36
} dvdPCWrapper;
37
/*
38
  Create a static preconditioner from a PC
39
*/
2223 jroman 40
#undef __FUNCT__
2019 eromero 41
#define __FUNCT__ "dvd_static_precond_PC"
1764 eromero 42
PetscErrorCode dvd_static_precond_PC(dvdDashboard *d, dvdBlackboard *b, PC pc)
1619 slepc 43
{
44
  PetscErrorCode  ierr;
45
  dvdPCWrapper    *dvdpc;
2004 eromero 46
  Mat             P;
1997 eromero 47
  MatStructure    str;
1619 slepc 48
 
49
  PetscFunctionBegin;
50
 
1764 eromero 51
  /* Setup the step */
52
  if (b->state >= DVD_STATE_CONF) {
1883 eromero 53
    /* If the preconditioner is valid */
54
    if (pc) {
1992 eromero 55
      ierr = PetscMalloc(sizeof(dvdPCWrapper), &dvdpc); CHKERRQ(ierr);
56
      dvdpc->pc = pc;
2013 eromero 57
      ierr = PetscObjectReference((PetscObject)pc); CHKERRQ(ierr);
1992 eromero 58
      d->improvex_precond_data = dvdpc;
59
      d->improvex_precond = dvd_static_precond_PC_0;
60
 
1997 eromero 61
      /* PC saves the matrix associated with the linear system, and it has to
62
         be initialize to a valid matrix */
2004 eromero 63
      ierr = PCGetOperators(pc, PETSC_NULL, &P, &str); CHKERRQ(ierr);
2244 eromero 64
      if (P) {
65
        ierr = PetscObjectReference((PetscObject)P); CHKERRQ(ierr);
66
        ierr = PCSetOperators(pc, P, P, str); CHKERRQ(ierr);
2305 jroman 67
        ierr = MatDestroy(&P); CHKERRQ(ierr);
2244 eromero 68
      } else
69
        d->improvex_precond = dvd_precond_none;
1867 eromero 70
 
1992 eromero 71
      DVD_FL_ADD(d->destroyList, dvd_improvex_precond_d);
72
 
1883 eromero 73
    /* Else, use no preconditioner */
74
    } else
75
      d->improvex_precond = dvd_precond_none;
1764 eromero 76
  }
1619 slepc 77
 
78
  PetscFunctionReturn(0);
79
}
80
 
2223 jroman 81
#undef __FUNCT__
1992 eromero 82
#define __FUNCT__ "dvd_improvex_precond_d"
2021 eromero 83
PetscErrorCode dvd_improvex_precond_d(dvdDashboard *d)
1992 eromero 84
{
85
  PetscErrorCode  ierr;
2013 eromero 86
  dvdPCWrapper    *dvdpc = (dvdPCWrapper*)d->improvex_precond_data;
1619 slepc 87
 
1992 eromero 88
  PetscFunctionBegin;
89
 
90
  /* Free local data */
2309 jroman 91
  if (dvdpc->pc) { ierr = PCDestroy(&dvdpc->pc);CHKERRQ(ierr); }
1992 eromero 92
  ierr = PetscFree(d->improvex_precond_data); CHKERRQ(ierr);
93
 
94
  PetscFunctionReturn(0);
95
}
96
 
97
 
2223 jroman 98
#undef __FUNCT__
99
#define __FUNCT__ "dvd_static_precond_PC_0"
1764 eromero 100
PetscErrorCode dvd_static_precond_PC_0(dvdDashboard *d, PetscInt i, Vec x,
101
                                       Vec Px)
1619 slepc 102
{
103
  PetscErrorCode  ierr;
1764 eromero 104
  dvdPCWrapper    *dvdpc = (dvdPCWrapper*)d->improvex_precond_data;
1619 slepc 105
 
106
  PetscFunctionBegin;
107
 
108
  ierr = PCApply(dvdpc->pc, x, Px); CHKERRQ(ierr);
109
 
110
  PetscFunctionReturn(0);
111
}
112
 
113
typedef struct {
1736 eromero 114
  Vec diagA, diagB;
1619 slepc 115
} dvdJacobiPrecond;
2223 jroman 116
 
117
#undef __FUNCT__
118
#define __FUNCT__ "dvd_jacobi_precond"
1619 slepc 119
/*
1883 eromero 120
  Create the Jacobi preconditioner for Generalized Eigenproblems
1619 slepc 121
*/
1736 eromero 122
PetscErrorCode dvd_jacobi_precond(dvdDashboard *d, dvdBlackboard *b)
1619 slepc 123
{
124
  PetscErrorCode  ierr;
125
  dvdJacobiPrecond
126
                  *dvdjp;
2216 jroman 127
  PetscBool       t;
1619 slepc 128
 
129
  PetscFunctionBegin;
130
 
1883 eromero 131
  /* Check if the problem matrices support GetDiagonal */
132
  ierr = MatHasOperation(d->A, MATOP_GET_DIAGONAL, &t); CHKERRQ(ierr);
2177 jroman 133
  if (t && d->B) {
1883 eromero 134
    ierr = MatHasOperation(d->B, MATOP_GET_DIAGONAL, &t); CHKERRQ(ierr);
135
  }
136
 
1736 eromero 137
  /* Setting configuration constrains */
2177 jroman 138
  b->own_vecs+= t?( (d->B == 0)?1:2 ) : 0;
1619 slepc 139
 
1736 eromero 140
  /* Setup the step */
141
  if (b->state >= DVD_STATE_CONF) {
2177 jroman 142
    if (t) {
1883 eromero 143
      ierr = PetscMalloc(sizeof(dvdJacobiPrecond), &dvdjp); CHKERRQ(ierr);
144
      dvdjp->diagA = *b->free_vecs; b->free_vecs++;
145
      ierr = MatGetDiagonal(d->A,dvdjp->diagA); CHKERRQ(ierr);
146
      if (d->B) {
147
        dvdjp->diagB = *b->free_vecs; b->free_vecs++;
148
        ierr = MatGetDiagonal(d->B, dvdjp->diagB); CHKERRQ(ierr);
149
      } else
150
        dvdjp->diagB = 0;
151
      d->improvex_precond_data = dvdjp;
152
      d->improvex_precond = dvd_jacobi_precond_0;
153
 
1992 eromero 154
      DVD_FL_ADD(d->destroyList, dvd_improvex_precond_d);
155
 
1883 eromero 156
    /* Else, use no preconditioner */
1736 eromero 157
    } else
1883 eromero 158
      d->improvex_precond = dvd_precond_none;
159
  }
1736 eromero 160
 
1619 slepc 161
  PetscFunctionReturn(0);
162
}
163
 
2223 jroman 164
#undef __FUNCT__
165
#define __FUNCT__ "dvd_jacobi_precond_0"
1736 eromero 166
PetscErrorCode dvd_jacobi_precond_0(dvdDashboard *d, PetscInt i, Vec x, Vec Px)
1619 slepc 167
{
168
  PetscErrorCode  ierr;
169
  dvdJacobiPrecond
1736 eromero 170
                  *dvdjp = (dvdJacobiPrecond*)d->improvex_precond_data;
1619 slepc 171
 
172
  PetscFunctionBegin;
173
 
174
  /* Compute inv(D - eig)*x */
1736 eromero 175
  if (dvdjp->diagB == 0) {
176
    /* Px <- diagA - l */
177
    ierr = VecCopy(dvdjp->diagA, Px); CHKERRQ(ierr);
178
    ierr = VecShift(Px, -d->eigr[i]); CHKERRQ(ierr);
179
  } else {
180
    /* Px <- diagA - l*diagB */
181
    ierr = VecWAXPY(Px, -d->eigr[i], dvdjp->diagB, dvdjp->diagA);
182
    CHKERRQ(ierr);
183
  }
1619 slepc 184
 
185
  /* Px(i) <- x/Px(i) */
186
  ierr = VecPointwiseDivide(Px, x, Px); CHKERRQ(ierr);
187
 
188
  PetscFunctionReturn(0);
189
}
190
 
2223 jroman 191
#undef __FUNCT__
192
#define __FUNCT__ "dvd_precond_none"
1883 eromero 193
/*
194
  Create a trivial preconditioner
195
*/
196
PetscErrorCode dvd_precond_none(dvdDashboard *d, PetscInt i, Vec x, Vec Px)
197
{
198
  PetscErrorCode  ierr;
1743 eromero 199
 
1883 eromero 200
  PetscFunctionBegin;
201
 
202
  ierr = VecCopy(x, Px); CHKERRQ(ierr);
203
 
204
  PetscFunctionReturn(0);
205
}
206
 
207
 
1743 eromero 208
/*
209
  Use of PETSc profiler functions
210
*/
211
 
212
/* Define stages */
213
#define DVD_STAGE_INITV 0
214
#define DVD_STAGE_NEWITER 1
215
#define DVD_STAGE_CALCPAIRS 2
216
#define DVD_STAGE_IMPROVEX 3
217
#define DVD_STAGE_UPDATEV 4
218
#define DVD_STAGE_ORTHV 5
219
 
2021 eromero 220
PetscErrorCode dvd_profiler_d(dvdDashboard *d);
1992 eromero 221
 
1743 eromero 222
typedef struct {
2021 eromero 223
  PetscErrorCode (*old_initV)(struct _dvdDashboard*);
224
  PetscErrorCode (*old_calcPairs)(struct _dvdDashboard*);
225
  PetscErrorCode (*old_improveX)(struct _dvdDashboard*, Vec *D,
226
                                 PetscInt max_size_D, PetscInt r_s,
227
                                 PetscInt r_e, PetscInt *size_D);
228
  PetscErrorCode (*old_updateV)(struct _dvdDashboard*);
229
  PetscErrorCode (*old_orthV)(struct _dvdDashboard*);
1743 eromero 230
} DvdProfiler;
231
 
2723 jroman 232
static PetscLogStage stages[6] = {0,0,0,0,0,0};
1978 eromero 233
 
1743 eromero 234
/*** Other things ****/
235
 
2223 jroman 236
#undef __FUNCT__
1745 eromero 237
#define __FUNCT__ "dvd_prof_init"
2223 jroman 238
PetscErrorCode dvd_prof_init()
239
{
1743 eromero 240
  PetscErrorCode  ierr;
241
 
1745 eromero 242
  PetscFunctionBegin;
1978 eromero 243
  if (!stages[0]) {
244
    ierr = PetscLogStageRegister("Dvd_step_initV", &stages[DVD_STAGE_INITV]);
245
    CHKERRQ(ierr);
2316 jroman 246
    ierr = PetscLogStageRegister("Dvd_step_calcPairs",&stages[DVD_STAGE_CALCPAIRS]);CHKERRQ(ierr);
247
    ierr = PetscLogStageRegister("Dvd_step_improveX",&stages[DVD_STAGE_IMPROVEX]);CHKERRQ(ierr);
248
    ierr = PetscLogStageRegister("Dvd_step_updateV",&stages[DVD_STAGE_UPDATEV]);CHKERRQ(ierr);
249
    ierr = PetscLogStageRegister("Dvd_step_orthV",&stages[DVD_STAGE_ORTHV]);CHKERRQ(ierr);
1978 eromero 250
  }
1743 eromero 251
  PetscFunctionReturn(0);
252
}
253
 
2223 jroman 254
#undef __FUNCT__
255
#define __FUNCT__ "dvd_initV_prof"
256
PetscErrorCode dvd_initV_prof(dvdDashboard* d)
257
{
1992 eromero 258
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
2021 eromero 259
  PetscErrorCode  ierr;
1743 eromero 260
 
261
  PetscFunctionBegin;
262
 
1978 eromero 263
  PetscLogStagePush(stages[DVD_STAGE_INITV]);
2021 eromero 264
  ierr = p->old_initV(d); CHKERRQ(ierr);
1743 eromero 265
  PetscLogStagePop();
266
 
2021 eromero 267
  PetscFunctionReturn(0);
1743 eromero 268
}
269
 
2223 jroman 270
#undef __FUNCT__
271
#define __FUNCT__ "dvd_calcPairs_prof"
272
PetscErrorCode dvd_calcPairs_prof(dvdDashboard* d)
273
{
1992 eromero 274
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
2021 eromero 275
  PetscErrorCode  ierr;
1743 eromero 276
 
277
  PetscFunctionBegin;
278
 
1978 eromero 279
  PetscLogStagePush(stages[DVD_STAGE_CALCPAIRS]);
2021 eromero 280
  ierr = p->old_calcPairs(d); CHKERRQ(ierr);
1743 eromero 281
  PetscLogStagePop();
282
 
2021 eromero 283
  PetscFunctionReturn(0);
1743 eromero 284
}
285
 
2223 jroman 286
#undef __FUNCT__
287
#define __FUNCT__ "dvd_improveX_prof"
2021 eromero 288
PetscErrorCode dvd_improveX_prof(dvdDashboard* d, Vec *D, PetscInt max_size_D,
2223 jroman 289
                       PetscInt r_s, PetscInt r_e, PetscInt *size_D)
290
{
1992 eromero 291
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
2021 eromero 292
  PetscErrorCode  ierr;
1743 eromero 293
 
294
  PetscFunctionBegin;
295
 
1978 eromero 296
  PetscLogStagePush(stages[DVD_STAGE_IMPROVEX]);
2021 eromero 297
  ierr = p->old_improveX(d, D, max_size_D, r_s, r_e, size_D); CHKERRQ(ierr);
1743 eromero 298
  PetscLogStagePop();
299
 
2021 eromero 300
  PetscFunctionReturn(0);
1743 eromero 301
}
302
 
2223 jroman 303
#undef __FUNCT__
304
#define __FUNCT__ "dvd_updateV_prof"
305
PetscErrorCode dvd_updateV_prof(dvdDashboard *d)
306
{
1992 eromero 307
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
2021 eromero 308
  PetscErrorCode  ierr;
1743 eromero 309
 
310
  PetscFunctionBegin;
311
 
1978 eromero 312
  PetscLogStagePush(stages[DVD_STAGE_UPDATEV]);
2021 eromero 313
  ierr = p->old_updateV(d); CHKERRQ(ierr);
1743 eromero 314
  PetscLogStagePop();
315
 
2021 eromero 316
  PetscFunctionReturn(0);
1743 eromero 317
}
318
 
2223 jroman 319
#undef __FUNCT__
320
#define __FUNCT__ "dvd_orthV_prof"
321
PetscErrorCode dvd_orthV_prof(dvdDashboard *d)
322
{
1992 eromero 323
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
2021 eromero 324
  PetscErrorCode  ierr;
1743 eromero 325
 
326
  PetscFunctionBegin;
327
 
1978 eromero 328
  PetscLogStagePush(stages[DVD_STAGE_ORTHV]);
2021 eromero 329
  ierr = p->old_orthV(d); CHKERRQ(ierr);
1743 eromero 330
  PetscLogStagePop();
331
 
2021 eromero 332
  PetscFunctionReturn(0);
1743 eromero 333
}
334
 
2223 jroman 335
#undef __FUNCT__
1992 eromero 336
#define __FUNCT__ "dvd_profiler"
337
PetscErrorCode dvd_profiler(dvdDashboard *d, dvdBlackboard *b)
338
{
339
  PetscErrorCode  ierr;
340
  DvdProfiler     *p;
1743 eromero 341
 
342
  PetscFunctionBegin;
343
 
1992 eromero 344
  /* Setup the step */
345
  if (b->state >= DVD_STATE_CONF) {
2307 jroman 346
    ierr = PetscFree(d->prof_data); CHKERRQ(ierr);
1992 eromero 347
    ierr = PetscMalloc(sizeof(DvdProfiler), &p); CHKERRQ(ierr);
348
    d->prof_data = p;
349
    p->old_initV = d->initV; d->initV = dvd_initV_prof;
350
    p->old_calcPairs = d->calcPairs; d->calcPairs = dvd_calcPairs_prof;
351
    p->old_improveX = d->improveX; d->improveX = dvd_improveX_prof;
352
    p->old_updateV = d->updateV; d->updateV = dvd_updateV_prof;
353
 
354
    DVD_FL_ADD(d->destroyList, dvd_profiler_d);
355
  }
356
 
357
  PetscFunctionReturn(0);
1743 eromero 358
}
359
 
2223 jroman 360
#undef __FUNCT__
1992 eromero 361
#define __FUNCT__ "dvd_profiler_d"
2021 eromero 362
PetscErrorCode dvd_profiler_d(dvdDashboard *d)
1992 eromero 363
{
364
  PetscErrorCode  ierr;
365
  DvdProfiler     *p = (DvdProfiler*)d->prof_data;
366
 
367
  PetscFunctionBegin;
368
 
369
  /* Free local data */
370
  ierr = PetscFree(p); CHKERRQ(ierr);
371
 
372
  PetscFunctionReturn(0);
373
}
374
 
375
 
376
 
1795 eromero 377
/*
378
  Configure the harmonics.
379
  switch(mode) {
380
  DVD_HARM_RR:    harmonic RR
381
  DVD_HARM_RRR:   relative harmonic RR
382
  DVD_HARM_REIGS: rightmost eigenvalues
383
  DVD_HARM_LEIGS: largest eigenvalues
384
  }
385
  fixedTarged, if true use the target instead of the best eigenvalue
386
  target, the fixed target to be used
387
*/
388
typedef struct {
389
  PetscScalar
390
    Wa, Wb,       /* span{W} = span{Wa*AV - Wb*BV} */
391
    Pa, Pb;       /* H=W'*(Pa*AV - Pb*BV), G=W'*(Wa*AV - Wb*BV) */
2216 jroman 392
  PetscBool
1795 eromero 393
    withTarget;
394
  HarmType_t
395
    mode;
1883 eromero 396
 
397
  /* old values of eps */
398
  EPSWhich
399
    old_which;
400
  PetscErrorCode
401
    (*old_which_func)(EPS,PetscScalar,PetscScalar,PetscScalar,PetscScalar,
402
                      PetscInt*,void*);
403
  void
404
    *old_which_ctx;
1795 eromero 405
} dvdHarmonic;
406
 
1883 eromero 407
PetscErrorCode dvd_harm_start(dvdDashboard *d);
408
PetscErrorCode dvd_harm_end(dvdDashboard *d);
2021 eromero 409
PetscErrorCode dvd_harm_d(dvdDashboard *d);
1795 eromero 410
PetscErrorCode dvd_harm_transf(dvdHarmonic *dvdh, PetscScalar t);
411
PetscErrorCode dvd_harm_updateW(dvdDashboard *d);
412
PetscErrorCode dvd_harm_proj(dvdDashboard *d);
1883 eromero 413
PetscErrorCode dvd_harm_sort(EPS eps, PetscScalar ar, PetscScalar ai,
414
                             PetscScalar br, PetscScalar bi, PetscInt *r,
415
                             void *ctx);
416
PetscErrorCode dvd_harm_eigs_trans(dvdDashboard *d);
1795 eromero 417
 
2223 jroman 418
#undef __FUNCT__
419
#define __FUNCT__ "dvd_harm_conf"
1795 eromero 420
PetscErrorCode dvd_harm_conf(dvdDashboard *d, dvdBlackboard *b,
2216 jroman 421
                             HarmType_t mode, PetscBool fixedTarget,
1795 eromero 422
                             PetscScalar t)
423
{
424
  PetscErrorCode  ierr;
425
  dvdHarmonic     *dvdh;
426
 
427
  PetscFunctionBegin;
428
 
2607 eromero 429
  /* Set the problem to GNHEP:
430
     d->G maybe is upper triangular due to biorthogonality of V and W */
1883 eromero 431
  d->sEP = d->sA = d->sB = 0;
432
 
1795 eromero 433
  /* Setup the step */
434
  if (b->state >= DVD_STATE_CONF) {
435
    ierr = PetscMalloc(sizeof(dvdHarmonic), &dvdh); CHKERRQ(ierr);
436
    dvdh->withTarget = fixedTarget;
437
    dvdh->mode = mode;
2177 jroman 438
    if (fixedTarget) dvd_harm_transf(dvdh, t);
1795 eromero 439
    d->calcpairs_W_data = dvdh;
440
    d->calcpairs_W = dvd_harm_updateW;
441
    d->calcpairs_proj_trans = dvd_harm_proj;
1883 eromero 442
    d->calcpairs_eigs_trans = dvd_harm_eigs_trans;
443
 
444
    DVD_FL_ADD(d->startList, dvd_harm_start);
445
    DVD_FL_ADD(d->endList, dvd_harm_end);
1992 eromero 446
    DVD_FL_ADD(d->destroyList, dvd_harm_d);
1795 eromero 447
  }
448
 
449
  PetscFunctionReturn(0);
450
}
451
 
1883 eromero 452
 
2223 jroman 453
#undef __FUNCT__
1992 eromero 454
#define __FUNCT__ "dvd_harm_d"
2021 eromero 455
PetscErrorCode dvd_harm_d(dvdDashboard *d)
1992 eromero 456
{
457
  PetscErrorCode  ierr;
458
 
459
  PetscFunctionBegin;
460
 
461
  /* Free local data */
462
  ierr = PetscFree(d->calcpairs_W_data); CHKERRQ(ierr);
463
 
464
  PetscFunctionReturn(0);
465
}
466
 
467
 
2223 jroman 468
#undef __FUNCT__
1883 eromero 469
#define __FUNCT__ "dvd_harm_start"
470
PetscErrorCode dvd_harm_start(dvdDashboard *d)
471
{
472
  dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
473
 
474
  PetscFunctionBegin;
475
 
476
  /* Overload the eigenpairs selection routine */
2096 eromero 477
  data->old_which = d->eps->which;
478
  data->old_which_func = d->eps->which_func;
479
  data->old_which_ctx = d->eps->which_ctx;
1975 eromero 480
  d->eps->which = EPS_WHICH_USER;
1883 eromero 481
  d->eps->which_func = dvd_harm_sort;
482
  d->eps->which_ctx = data;
483
 
484
  PetscFunctionReturn(0);
485
}
486
 
487
 
2223 jroman 488
#undef __FUNCT__
1883 eromero 489
#define __FUNCT__ "dvd_harm_end"
490
PetscErrorCode dvd_harm_end(dvdDashboard *d)
491
{
492
  dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
493
 
494
  PetscFunctionBegin;
495
 
496
  /* Restore the eigenpairs selection routine */
497
  d->eps->which = data->old_which;
498
  d->eps->which_func = data->old_which_func;
499
  d->eps->which_ctx = data->old_which_ctx;
500
 
501
  PetscFunctionReturn(0);
502
}
503
 
504
 
2223 jroman 505
#undef __FUNCT__
506
#define __FUNCT__ "dvd_harm_transf"
1795 eromero 507
PetscErrorCode dvd_harm_transf(dvdHarmonic *dvdh, PetscScalar t)
508
{
509
  PetscFunctionBegin;
510
 
511
  switch(dvdh->mode) {
512
  case DVD_HARM_RR:    /* harmonic RR */
1883 eromero 513
    dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 0.0; dvdh->Pb = -1.0; break;
1795 eromero 514
  case DVD_HARM_RRR:   /* relative harmonic RR */
515
    dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 1.0; dvdh->Pb = 0.0; break;
516
  case DVD_HARM_REIGS: /* rightmost eigenvalues */
1883 eromero 517
    dvdh->Wa = 1.0; dvdh->Wb = t;   dvdh->Pa = 1.0; dvdh->Pb = -PetscConj(t);
518
    break;
1795 eromero 519
  case DVD_HARM_LEIGS: /* largest eigenvalues */
1883 eromero 520
    dvdh->Wa = 0.0; dvdh->Wb = 1.0; dvdh->Pa = 1.0; dvdh->Pb = 0.0; break;
521
  case DVD_HARM_NONE:
522
  default:
2730 jroman 523
    SETERRQ(PETSC_COMM_SELF,1, "Harmonic type not supported");
1795 eromero 524
  }
525
 
2035 eromero 526
  /* Check the transformation does not change the sign of the imaginary part */
527
#if !defined(PETSC_USE_COMPLEX)
528
  if (dvdh->Pb*dvdh->Wa - dvdh->Wb*dvdh->Pa < 0.0)
529
    dvdh->Pa*= -1.0, dvdh->Pb*= -1.0;
530
#endif
531
 
1795 eromero 532
  PetscFunctionReturn(0);
533
}
534
 
2223 jroman 535
#undef __FUNCT__
536
#define __FUNCT__ "dvd_harm_updateW"
1795 eromero 537
PetscErrorCode dvd_harm_updateW(dvdDashboard *d)
538
{
539
  dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
540
  PetscErrorCode  ierr;
541
  PetscInt        i;
542
 
543
  PetscFunctionBegin;
544
 
545
  /* Update the target if it is necessary */
2177 jroman 546
  if (!data->withTarget) dvd_harm_transf(data, d->eigr[0]);
1795 eromero 547
 
548
  for(i=d->V_new_s; i<d->V_new_e; i++) {
1883 eromero 549
    /* W(i) <- Wa*AV(i) - Wb*BV(i) */
1820 eromero 550
    ierr = VecCopy(d->AV[i], d->W[i]); CHKERRQ(ierr);
1883 eromero 551
    ierr = VecAXPBY(d->W[i], -data->Wb, data->Wa, (d->BV?d->BV:d->V)[i]);
552
    CHKERRQ(ierr);
1795 eromero 553
  }
554
 
555
  PetscFunctionReturn(0);
556
}
557
 
2223 jroman 558
#undef __FUNCT__
559
#define __FUNCT__ "dvd_harm_proj"
1795 eromero 560
PetscErrorCode dvd_harm_proj(dvdDashboard *d)
561
{
562
  dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
563
  PetscInt        i,j;
564
 
565
  PetscFunctionBegin;
566
 
567
  if (d->sH != d->sG) {
2730 jroman 568
    SETERRQ(PETSC_COMM_SELF,1,"Projected matrices H and G must have the same structure");
1795 eromero 569
  }
570
 
571
  /* [H G] <- [Pa*H - Pb*G, Wa*H - Wb*G] */
572
  if (DVD_ISNOT(d->sH,DVD_MAT_LTRIANG))     /* Upper triangular part */
2624 eromero 573
    for(i=d->V_new_s+d->cX_in_H; i<d->V_new_e+d->cX_in_H; i++)
1795 eromero 574
      for(j=0; j<=i; j++) {
575
        PetscScalar h = d->H[d->ldH*i+j], g = d->G[d->ldH*i+j];
576
        d->H[d->ldH*i+j] = data->Pa*h - data->Pb*g;
577
        d->G[d->ldH*i+j] = data->Wa*h - data->Wb*g;
578
      }
579
  if (DVD_ISNOT(d->sH,DVD_MAT_UTRIANG))     /* Lower triangular part */
2624 eromero 580
    for(i=0; i<d->V_new_e+d->cX_in_H; i++)
581
      for(j=PetscMax(d->V_new_s+d->cX_in_H,i+(DVD_ISNOT(d->sH,DVD_MAT_LTRIANG)?1:0));
582
          j<d->V_new_e+d->cX_in_H; j++) {
1795 eromero 583
        PetscScalar h = d->H[d->ldH*i+j], g = d->G[d->ldH*i+j];
584
        d->H[d->ldH*i+j] = data->Pa*h - data->Pb*g;
585
        d->G[d->ldH*i+j] = data->Wa*h - data->Wb*g;
586
      }
587
 
588
  PetscFunctionReturn(0);
589
}
590
 
2223 jroman 591
#undef __FUNCT__
592
#define __FUNCT__ "dvd_harm_backtrans"
1883 eromero 593
PetscErrorCode dvd_harm_backtrans(dvdHarmonic *data, PetscScalar *ar,
594
                                  PetscScalar *ai)
595
{
1990 eromero 596
  PetscScalar xr;
597
#if !defined(PETSC_USE_COMPLEX)
598
  PetscScalar xi, k;
599
#endif
600
 
1883 eromero 601
  PetscFunctionBegin;
2214 jroman 602
  PetscValidPointer(ar,2);
1990 eromero 603
  xr = *ar;
604
#if !defined(PETSC_USE_COMPLEX)
2214 jroman 605
  PetscValidPointer(ai,3);
1990 eromero 606
  xi = *ai;
607
 
608
  if (xi != 0.0) {
609
    k = (data->Pa - data->Wa*xr)*(data->Pa - data->Wa*xr) +
610
        data->Wa*data->Wa*xi*xi;
611
    *ar = (data->Pb*data->Pa - (data->Pb*data->Wa + data->Wb*data->Pa)*xr +
612
           data->Wb*data->Wa*(xr*xr + xi*xi))/k;
613
    *ai = (data->Pb*data->Wa - data->Wb*data->Pa)*xi/k;
614
  } else
615
#endif
616
    *ar = (data->Pb - data->Wb*xr) / (data->Pa - data->Wa*xr);
617
 
1883 eromero 618
  PetscFunctionReturn(0);
619
}
620
 
621
 
2223 jroman 622
#undef __FUNCT__
623
#define __FUNCT__ "dvd_harm_sort"
1883 eromero 624
PetscErrorCode dvd_harm_sort(EPS eps, PetscScalar ar, PetscScalar ai,
625
                             PetscScalar br, PetscScalar bi, PetscInt *r,
626
                             void *ctx)
627
{
628
  dvdHarmonic     *data = (dvdHarmonic*)ctx;
629
  PetscErrorCode  ierr;
630
 
631
  PetscFunctionBegin;
632
 
633
  /* Back-transform the harmonic values */
634
  dvd_harm_backtrans(data, &ar, &ai);
635
  dvd_harm_backtrans(data, &br, &bi);
636
 
637
  /* Compare values using the user options for the eigenpairs selection */
638
  eps->which = data->old_which;
639
  eps->which_func = data->old_which_func;
640
  eps->which_ctx = data->old_which_ctx;
641
  ierr = EPSCompareEigenvalues(eps, ar, ai, br, bi, r); CHKERRQ(ierr);
642
 
643
  /* Restore the eps values */
1975 eromero 644
  eps->which = EPS_WHICH_USER;
1883 eromero 645
  eps->which_func = dvd_harm_sort;
646
  eps->which_ctx = data;
647
 
648
  PetscFunctionReturn(0);
649
}
650
 
2223 jroman 651
#undef __FUNCT__
652
#define __FUNCT__ "dvd_harm_eigs_trans"
1883 eromero 653
PetscErrorCode dvd_harm_eigs_trans(dvdDashboard *d)
654
{
655
  dvdHarmonic     *data = (dvdHarmonic*)d->calcpairs_W_data;
656
  PetscInt        i;
657
 
658
  PetscFunctionBegin;
659
 
660
  for(i=0; i<d->size_H; i++)
2624 eromero 661
    dvd_harm_backtrans(data, &d->eigr[i-d->cX_in_H], &d->eigi[i-d->cX_in_H]);
1883 eromero 662
 
663
  PetscFunctionReturn(0);
664
}
665
 
666