Subversion Repositories slepc-dev

Rev

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

Rev Author Line No. Line
1619 slepc 1
/*
2110 jroman 2
  Method: General Davidson Method (includes GD and JD)
1619 slepc 3
 
4
  References:
5
    - Ernest R. Davidson. Super-matrix methods. Computer Physics Communications,
6
      53:49–60, May 1989.
2110 jroman 7
 
8
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9
   SLEPc - Scalable Library for Eigenvalue Problem Computations
2575 eromero 10
   Copyright (c) 2002-2011, Universitat Politecnica de Valencia, Spain
2110 jroman 11
 
12
   This file is part of SLEPc.
13
 
14
   SLEPc is free software: you can redistribute it and/or modify it under  the
15
   terms of version 3 of the GNU Lesser General Public License as published by
16
   the Free Software Foundation.
17
 
18
   SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
19
   WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
20
   FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
21
   more details.
22
 
23
   You  should have received a copy of the GNU Lesser General  Public  License
24
   along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
25
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1619 slepc 26
*/
27
 
1985 eromero 28
#include "davidson.h"
1619 slepc 29
 
2324 jroman 30
PetscErrorCode EPSView_Davidson(EPS eps,PetscViewer viewer);
1993 eromero 31
 
2244 eromero 32
typedef struct {
33
  /**** Solver options ****/
34
  PetscInt blocksize,     /* block size */
35
    initialsize,          /* initial size of V */
36
    minv,                 /* size of V after restarting */
37
    plusk;                /* keep plusk eigenvectors from the last iteration */
38
  PetscBool  ipB;         /* true if V'B*V=I */
39
  PetscInt   method;      /* method for improving the approximate solution */
40
  PetscReal  fix;         /* the fix parameter */
41
  PetscBool  krylovstart; /* true if the starting subspace is a Krylov basis */
2608 eromero 42
  PetscBool  dynamic;     /* true if dynamic stopping criterion is used */
2611 eromero 43
  PetscInt   cX_in_proj,  /* converged vectors in the projected problem */
44
    cX_in_impr;           /* converged vectors in the projector */
2244 eromero 45
 
46
  /**** Solver data ****/
47
  dvdDashboard ddb;
48
 
49
  /**** Things to destroy ****/
50
  PetscScalar *wS;
51
  Vec         *wV;
52
  PetscInt    size_wV;
53
} EPS_DAVIDSON;
54
 
1982 eromero 55
#undef __FUNCT__  
2324 jroman 56
#define __FUNCT__ "EPSCreate_Davidson"
57
PetscErrorCode EPSCreate_Davidson(EPS eps)
2317 jroman 58
{
59
  PetscErrorCode ierr;
60
  EPS_DAVIDSON   *data;
1756 eromero 61
 
1982 eromero 62
  PetscFunctionBegin;
63
 
64
  eps->OP->ops->getbilinearform  = STGetBilinearForm_Default;
2324 jroman 65
  eps->ops->solve                = EPSSolve_Davidson;
66
  eps->ops->setup                = EPSSetUp_Davidson;
2348 jroman 67
  eps->ops->reset                = EPSReset_Davidson;
1982 eromero 68
  eps->ops->backtransform        = EPSBackTransform_Default;
2555 eromero 69
  eps->ops->computevectors       = EPSComputeVectors_Davidson;
2324 jroman 70
  eps->ops->view                 = EPSView_Davidson;
1982 eromero 71
 
2331 jroman 72
  ierr = PetscMalloc(sizeof(EPS_DAVIDSON),&data);CHKERRQ(ierr);
1982 eromero 73
  eps->data = data;
2432 eromero 74
  data->wS = PETSC_NULL;
75
  data->wV = PETSC_NULL;
76
  data->size_wV = 0;
2519 eromero 77
  ierr = PetscMemzero(&data->ddb,sizeof(dvdDashboard));CHKERRQ(ierr);
1982 eromero 78
 
79
  /* Set default values */
2331 jroman 80
  ierr = EPSDavidsonSetKrylovStart_Davidson(eps,PETSC_FALSE);CHKERRQ(ierr);
81
  ierr = EPSDavidsonSetBlockSize_Davidson(eps,1);CHKERRQ(ierr);
82
  ierr = EPSDavidsonSetRestart_Davidson(eps,6,0);CHKERRQ(ierr);
83
  ierr = EPSDavidsonSetInitialSize_Davidson(eps,5);CHKERRQ(ierr);
84
  ierr = EPSDavidsonSetFix_Davidson(eps,0.01);CHKERRQ(ierr);
2555 eromero 85
  ierr = EPSDavidsonSetBOrth_Davidson(eps,PETSC_TRUE);CHKERRQ(ierr);
2608 eromero 86
  ierr = EPSDavidsonSetConstantCorrectionTolerance_Davidson(eps,PETSC_TRUE);CHKERRQ(ierr);
2611 eromero 87
  ierr = EPSDavidsonSetWindowSizes_Davidson(eps,0,0);CHKERRQ(ierr);
1982 eromero 88
  PetscFunctionReturn(0);
89
}
90
 
1619 slepc 91
#undef __FUNCT__  
2324 jroman 92
#define __FUNCT__ "EPSSetUp_Davidson"
93
PetscErrorCode EPSSetUp_Davidson(EPS eps)
2317 jroman 94
{
95
  PetscErrorCode ierr;
96
  EPS_DAVIDSON   *data = (EPS_DAVIDSON*)eps->data;
97
  dvdDashboard   *dvd = &data->ddb;
98
  dvdBlackboard  b;
2611 eromero 99
  PetscInt       nvecs,nscalars,min_size_V,plusk,bs,initv,i,cX_in_proj,cX_in_impr;
2317 jroman 100
  Mat            A,B;
101
  KSP            ksp;
2608 eromero 102
  PetscBool      t,ipB,ispositive,dynamic;
2317 jroman 103
  HarmType_t     harm;
104
  InitType_t     init;
105
  PetscReal      fix;
2566 eromero 106
  PetscScalar    target;
1619 slepc 107
 
108
  PetscFunctionBegin;
109
  /* Setup EPS options and get the problem specification */
2331 jroman 110
  ierr = EPSDavidsonGetBlockSize_Davidson(eps,&bs);CHKERRQ(ierr);
2023 eromero 111
  if (bs <= 0) bs = 1;
1619 slepc 112
  if(eps->ncv) {
2214 jroman 113
    if (eps->ncv<eps->nev) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The value of ncv must be at least nev");
2023 eromero 114
  } else if (eps->mpd) eps->ncv = eps->mpd + eps->nev + bs;
115
  else if (eps->nev<500)
2678 eromero 116
    eps->ncv = PetscMin(eps->n-bs,PetscMax(2*eps->nev,eps->nev+15))+bs;
2023 eromero 117
  else
2678 eromero 118
    eps->ncv = PetscMin(eps->n-bs,eps->nev+500)+bs;
2023 eromero 119
  if (!eps->mpd) eps->mpd = eps->ncv;
120
  if (eps->mpd > eps->ncv)
2214 jroman 121
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The mpd has to be less or equal than ncv");
2023 eromero 122
  if (eps->mpd < 2)
2214 jroman 123
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The mpd has to be greater than 2");
2397 eromero 124
  if (!eps->max_it) eps->max_it = PetscMax(100*eps->ncv,2*eps->n);
1976 eromero 125
  if (!eps->which) eps->which = EPS_LARGEST_MAGNITUDE;
126
  if (eps->ishermitian && (eps->which==EPS_LARGEST_IMAGINARY || eps->which==EPS_SMALLEST_IMAGINARY))
2214 jroman 127
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Wrong value of eps->which");
2023 eromero 128
  if (!(eps->nev + bs <= eps->ncv))
2331 jroman 129
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The ncv has to be greater than nev plus blocksize!");
1619 slepc 130
 
2331 jroman 131
  ierr = EPSDavidsonGetRestart_Davidson(eps,&min_size_V,&plusk);CHKERRQ(ierr);
132
  if (!min_size_V) min_size_V = PetscMin(PetscMax(bs,5),eps->mpd/2);
2023 eromero 133
  if (!(min_size_V+bs <= eps->mpd))
2331 jroman 134
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The value of minv must be less than mpd minus blocksize");
135
  ierr = EPSDavidsonGetInitialSize_Davidson(eps,&initv);CHKERRQ(ierr);
2023 eromero 136
  if (eps->mpd < initv)
2214 jroman 137
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"The initv has to be less or equal than mpd");
1619 slepc 138
 
2021 eromero 139
  /* Davidson solvers do not support left eigenvectors */
2214 jroman 140
  if (eps->leftvecs) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Left vectors not supported in this solver");
2021 eromero 141
 
2616 eromero 142
  /* Set STPrecond as the default ST */
143
  if (!((PetscObject)eps->OP)->type_name) {
144
    ierr = STSetType(eps->OP,STPRECOND);CHKERRQ(ierr);
145
  }
146
  ierr = STPrecondSetKSPHasMat(eps->OP,PETSC_FALSE);CHKERRQ(ierr);
147
 
2104 eromero 148
  /* Change the default sigma to inf if necessary */
149
  if (eps->which == EPS_LARGEST_MAGNITUDE || eps->which == EPS_LARGEST_REAL ||
150
      eps->which == EPS_LARGEST_IMAGINARY) {
2396 eromero 151
    ierr = STSetDefaultShift(eps->OP,PETSC_MAX_REAL);CHKERRQ(ierr);
2104 eromero 152
  }
153
 
1997 eromero 154
  /* Davidson solvers only support STPRECOND */
2330 jroman 155
  ierr = STSetUp(eps->OP);CHKERRQ(ierr);
2331 jroman 156
  ierr = PetscTypeCompare((PetscObject)eps->OP,STPRECOND,&t);CHKERRQ(ierr);
157
  if (!t) SETERRQ1(((PetscObject)eps)->comm,PETSC_ERR_SUP,"%s only works with precond spectral transformation",
2003 eromero 158
    ((PetscObject)eps)->type_name);
2015 eromero 159
 
1619 slepc 160
  /* Setup problem specification in dvd */
2331 jroman 161
  ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
2519 eromero 162
  ierr = EPSReset_Davidson(eps);CHKERRQ(ierr);
2331 jroman 163
  ierr = PetscMemzero(dvd,sizeof(dvdDashboard));CHKERRQ(ierr);
2177 jroman 164
  dvd->A = A; dvd->B = eps->isgeneralized? B : PETSC_NULL;
2021 eromero 165
  ispositive = eps->ispositive;
1747 eromero 166
  dvd->sA = DVD_MAT_IMPLICIT |
2177 jroman 167
            (eps->ishermitian? DVD_MAT_HERMITIAN : 0) |
2316 jroman 168
            ((ispositive && !eps->isgeneralized) ? DVD_MAT_POS_DEF : 0);
1764 eromero 169
  /* Asume -eps_hermitian means hermitian-definite in generalized problems */
2177 jroman 170
  if (!ispositive && !eps->isgeneralized && eps->ishermitian) ispositive = PETSC_TRUE;
171
  if (!eps->isgeneralized)
1747 eromero 172
    dvd->sB = DVD_MAT_IMPLICIT | DVD_MAT_HERMITIAN | DVD_MAT_IDENTITY |
1764 eromero 173
              DVD_MAT_UNITARY | DVD_MAT_POS_DEF;
1747 eromero 174
  else
175
    dvd->sB = DVD_MAT_IMPLICIT |
2177 jroman 176
              (eps->ishermitian? DVD_MAT_HERMITIAN : 0) |
177
              (ispositive? DVD_MAT_POS_DEF : 0);
2558 eromero 178
  ipB = (dvd->B && data->ipB && DVD_IS(dvd->sB,DVD_MAT_POS_DEF))?PETSC_TRUE:PETSC_FALSE;
2555 eromero 179
  data->ipB = ipB;
2558 eromero 180
  dvd->correctXnorm = ipB;
2177 jroman 181
  dvd->sEP = ((!eps->isgeneralized || (eps->isgeneralized && ipB))? DVD_EP_STD : 0) |
2316 jroman 182
             (ispositive? DVD_EP_HERMITIAN : 0);
1619 slepc 183
  dvd->nev = eps->nev;
184
  dvd->which = eps->which;
2566 eromero 185
  dvd->withTarget = PETSC_TRUE;
1805 eromero 186
  switch(eps->which) {
187
  case EPS_TARGET_MAGNITUDE:
188
  case EPS_TARGET_IMAGINARY:
2566 eromero 189
    dvd->target[0] = target = eps->target; dvd->target[1] = 1.0;
1805 eromero 190
    break;
1883 eromero 191
 
2566 eromero 192
  case EPS_TARGET_REAL:
193
    dvd->target[0] = PetscRealPart(target = eps->target); dvd->target[1] = 1.0;
194
    break;
195
 
196
  case EPS_LARGEST_REAL:
1883 eromero 197
  case EPS_LARGEST_MAGNITUDE:
2607 eromero 198
  case EPS_LARGEST_IMAGINARY: /* TODO: think about this case */
1805 eromero 199
  default:
2566 eromero 200
    dvd->target[0] = 1.0; dvd->target[1] = target = 0.0;
1883 eromero 201
    break;
202
 
203
  case EPS_SMALLEST_MAGNITUDE:
204
  case EPS_SMALLEST_REAL:
2607 eromero 205
  case EPS_SMALLEST_IMAGINARY: /* TODO: think about this case */
2566 eromero 206
    dvd->target[0] = target = 0.0; dvd->target[1] = 1.0;
207
    break;
208
 
209
  case EPS_WHICH_USER:
210
    ierr = STGetShift(eps->OP,&target);CHKERRQ(ierr);
211
    dvd->target[0] = target; dvd->target[1] = 1.0;
212
    break;
213
 
214
  case EPS_ALL:
215
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Unsupported option: which == EPS_ALL");
216
    break;
1805 eromero 217
  }
2621 eromero 218
  dvd->tol = eps->tol==PETSC_DEFAULT?SLEPC_DEFAULT_TOL:eps->tol;
1805 eromero 219
  dvd->eps = eps;
1619 slepc 220
 
1976 eromero 221
  /* Setup the extraction technique */
2231 jroman 222
  if (!eps->extraction) {
2678 eromero 223
    if (ipB || ispositive) eps->extraction = EPS_RITZ;
224
    else {
225
      switch(eps->which) {
226
      case EPS_TARGET_REAL: case EPS_TARGET_MAGNITUDE: case EPS_TARGET_IMAGINARY:
227
      case EPS_SMALLEST_MAGNITUDE: case EPS_SMALLEST_REAL: case EPS_SMALLEST_IMAGINARY:
228
      eps->extraction = EPS_HARMONIC;
229
      break;
230
      case EPS_LARGEST_REAL: case EPS_LARGEST_MAGNITUDE: case EPS_LARGEST_IMAGINARY:
2566 eromero 231
      eps->extraction = EPS_HARMONIC_LARGEST;
2678 eromero 232
      break;
233
      default:
2566 eromero 234
      eps->extraction = EPS_RITZ;
2678 eromero 235
      }
236
    }
2231 jroman 237
  }
1976 eromero 238
  switch(eps->extraction) {
239
  case EPS_RITZ:              harm = DVD_HARM_NONE; break;
240
  case EPS_HARMONIC:          harm = DVD_HARM_RR; break;
241
  case EPS_HARMONIC_RELATIVE: harm = DVD_HARM_RRR; break;
242
  case EPS_HARMONIC_RIGHT:    harm = DVD_HARM_REIGS; break;
243
  case EPS_HARMONIC_LARGEST:  harm = DVD_HARM_LEIGS; break;
2214 jroman 244
  default: SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Unsupported extraction type");
1976 eromero 245
  }
246
 
247
  /* Setup the type of starting subspace */
2331 jroman 248
  ierr = EPSDavidsonGetKrylovStart_Davidson(eps,&t);CHKERRQ(ierr);
2177 jroman 249
  init = (!t)? DVD_INITV_CLASSIC : DVD_INITV_KRYLOV;
1976 eromero 250
 
2611 eromero 251
  /* Setup the presence of converged vectors in the projected problem and in the projector */
252
  ierr = EPSDavidsonGetWindowSizes_Davidson(eps,&cX_in_impr,&cX_in_proj);CHKERRQ(ierr);
2762 jroman 253
  if (min_size_V <= cX_in_proj) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"minv has to be greater than qwindow");
254
  if (bs > 1 && cX_in_impr > 0) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Unsupported option: pwindow > 0 and bs > 1");
2611 eromero 255
 
1747 eromero 256
  /* Setup IP */
2177 jroman 257
  if (ipB && dvd->B) {
2380 jroman 258
    ierr = IPSetMatrix(eps->ip,dvd->B);CHKERRQ(ierr);
1764 eromero 259
  } else {
2380 jroman 260
    ierr = IPSetMatrix(eps->ip,PETSC_NULL);CHKERRQ(ierr);
1764 eromero 261
  }
1747 eromero 262
 
1995 eromero 263
  /* Get the fix parameter */
2331 jroman 264
  ierr = EPSDavidsonGetFix_Davidson(eps,&fix);CHKERRQ(ierr);
1995 eromero 265
 
2608 eromero 266
  /* Get whether the stopping criterion is used */
267
  ierr = EPSDavidsonGetConstantCorrectionTolerance_Davidson(eps,&dynamic);CHKERRQ(ierr);
268
 
1989 eromero 269
  /* Orthonormalize the DS */
2331 jroman 270
  ierr = dvd_orthV(eps->ip,PETSC_NULL,0,PETSC_NULL,0,eps->DS,0,
2605 eromero 271
                   PetscAbs(eps->nds),PETSC_NULL,eps->rand);CHKERRQ(ierr);
1989 eromero 272
 
1867 eromero 273
  /* Preconfigure dvd */
2331 jroman 274
  ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
2605 eromero 275
  ierr = dvd_schm_basic_preconf(dvd,&b,eps->mpd,min_size_V,bs,
2188 eromero 276
                                initv,
277
                                PetscAbs(eps->nini),
2331 jroman 278
                                plusk,harm,
2605 eromero 279
                                ksp,init,eps->trackall,
2611 eromero 280
                                ipB?DVD_ORTHOV_BOneMV:DVD_ORTHOV_I,cX_in_proj,cX_in_impr);
2605 eromero 281
  CHKERRQ(ierr);
1619 slepc 282
 
2346 eromero 283
  /* Allocate memory */
1619 slepc 284
  nvecs = b.max_size_auxV + b.own_vecs;
285
  nscalars = b.own_scalars + b.max_size_auxS;
2346 eromero 286
  ierr = PetscMalloc(nscalars*sizeof(PetscScalar),&data->wS);CHKERRQ(ierr);
2410 jroman 287
  ierr = VecDuplicateVecs(eps->t,nvecs,&data->wV);CHKERRQ(ierr);
1992 eromero 288
  data->size_wV = nvecs;
1619 slepc 289
  b.free_vecs = data->wV;
2346 eromero 290
  b.free_scalars = data->wS;
1619 slepc 291
  dvd->auxV = data->wV + b.own_vecs;
292
  dvd->auxS = b.free_scalars + b.own_scalars;
293
  dvd->size_auxV = b.max_size_auxV;
294
  dvd->size_auxS = b.max_size_auxS;
1805 eromero 295
 
2396 eromero 296
  eps->errest_left = PETSC_NULL;
297
  ierr = PetscMalloc(eps->ncv*sizeof(PetscInt),&eps->perm);CHKERRQ(ierr);
298
  for(i=0; i<eps->ncv; i++) eps->perm[i] = i;
299
 
1619 slepc 300
  /* Configure dvd for a basic GD */
2605 eromero 301
  ierr = dvd_schm_basic_conf(dvd,&b,eps->mpd,min_size_V,bs,
2188 eromero 302
                             initv,
2331 jroman 303
                             PetscAbs(eps->nini),plusk,
304
                             eps->ip,harm,dvd->withTarget,
2566 eromero 305
                             target,ksp,
2605 eromero 306
                             fix,init,eps->trackall,
2611 eromero 307
                             ipB?DVD_ORTHOV_BOneMV:DVD_ORTHOV_I,cX_in_proj,cX_in_impr,dynamic);
2605 eromero 308
  CHKERRQ(ierr);
1795 eromero 309
 
1619 slepc 310
  /* Associate the eigenvalues to the EPS */
2605 eromero 311
  eps->eigr = dvd->real_eigr;
312
  eps->eigi = dvd->real_eigi;
313
  eps->errest = dvd->real_errest;
314
  eps->V = dvd->real_V;
2396 eromero 315
 
316
 
1619 slepc 317
  PetscFunctionReturn(0);
318
}
319
 
320
#undef __FUNCT__  
2324 jroman 321
#define __FUNCT__ "EPSSolve_Davidson"
322
PetscErrorCode EPSSolve_Davidson(EPS eps)
2317 jroman 323
{
324
  EPS_DAVIDSON   *data = (EPS_DAVIDSON*)eps->data;
325
  dvdDashboard   *d = &data->ddb;
326
  PetscErrorCode ierr;
1619 slepc 327
 
328
  PetscFunctionBegin;
1883 eromero 329
  /* Call the starting routines */
2331 jroman 330
  DVD_FL_CALL(d->startList,d);
1883 eromero 331
 
1619 slepc 332
  for(eps->its=0; eps->its < eps->max_it; eps->its++) {
1934 eromero 333
    /* Initialize V, if it is needed */
2330 jroman 334
    if (d->size_V == 0) { ierr = d->initV(d);CHKERRQ(ierr); }
1619 slepc 335
 
336
    /* Find the best approximated eigenpairs in V, X */
2330 jroman 337
    ierr = d->calcPairs(d);CHKERRQ(ierr);
1619 slepc 338
 
2605 eromero 339
    /* Test for convergence */
340
    if (eps->nconv >= eps->nev) break;
341
 
1934 eromero 342
    /* Expand the subspace */
2330 jroman 343
    ierr = d->updateV(d);CHKERRQ(ierr);
1619 slepc 344
 
1735 eromero 345
    /* Monitor progress */
1750 eromero 346
    eps->nconv = d->nconv;
2605 eromero 347
    ierr = EPSMonitor(eps,eps->its+1,eps->nconv,eps->eigr,eps->eigi,eps->errest,d->size_V+d->size_cX);CHKERRQ(ierr);
1883 eromero 348
  }
1675 slepc 349
 
1883 eromero 350
  /* Call the ending routines */
2331 jroman 351
  DVD_FL_CALL(d->endList,d);
1735 eromero 352
 
2331 jroman 353
  if (eps->nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
1619 slepc 354
  else eps->reason = EPS_DIVERGED_ITS;
2396 eromero 355
 
1619 slepc 356
  PetscFunctionReturn(0);
357
}
358
 
359
#undef __FUNCT__  
2348 jroman 360
#define __FUNCT__ "EPSReset_Davidson"
361
PetscErrorCode EPSReset_Davidson(EPS eps)
2317 jroman 362
{
363
  EPS_DAVIDSON   *data = (EPS_DAVIDSON*)eps->data;
364
  dvdDashboard   *dvd = &data->ddb;
365
  PetscErrorCode ierr;
1992 eromero 366
 
367
  PetscFunctionBegin;
368
  /* Call step destructors and destroys the list */
2331 jroman 369
  DVD_FL_CALL(dvd->destroyList,dvd);
1992 eromero 370
  DVD_FL_DEL(dvd->destroyList);
371
  DVD_FL_DEL(dvd->startList);
372
  DVD_FL_DEL(dvd->endList);
373
 
2432 eromero 374
  if (data->size_wV > 0) {
375
    ierr = VecDestroyVecs(data->size_wV,&data->wV);CHKERRQ(ierr);
376
  }
2307 jroman 377
  ierr = PetscFree(data->wS);CHKERRQ(ierr);
2396 eromero 378
  ierr = PetscFree(eps->perm);CHKERRQ(ierr);
1992 eromero 379
  PetscFunctionReturn(0);
380
}
381
 
1993 eromero 382
#undef __FUNCT__  
2324 jroman 383
#define __FUNCT__ "EPSView_Davidson"
384
PetscErrorCode EPSView_Davidson(EPS eps,PetscViewer viewer)
1993 eromero 385
{
2317 jroman 386
  PetscErrorCode ierr;
2331 jroman 387
  PetscBool      isascii,opb;
388
  PetscInt       opi,opi0;
2317 jroman 389
  const char*    name;
1993 eromero 390
 
391
  PetscFunctionBegin;
392
  name = ((PetscObject)eps)->type_name;
2215 jroman 393
  ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
2762 jroman 394
  if (!isascii) SETERRQ2(((PetscObject)eps)->comm,1,"Viewer type %s not supported for %s",((PetscObject)viewer)->type_name,name);
1993 eromero 395
 
2555 eromero 396
  ierr = EPSDavidsonGetBOrth_Davidson(eps,&opb);CHKERRQ(ierr);
2331 jroman 397
  ierr = EPSDavidsonGetBlockSize_Davidson(eps,&opi);CHKERRQ(ierr);
2555 eromero 398
  if(!opb) {
399
    ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: search subspace is I-orthogonalized\n");CHKERRQ(ierr);
400
  } else {
401
    ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: search subspace is B-orthogonalized\n");CHKERRQ(ierr);
402
  }
2394 jroman 403
  ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: block size=%D\n",opi);CHKERRQ(ierr);
2331 jroman 404
  ierr = EPSDavidsonGetKrylovStart_Davidson(eps,&opb);CHKERRQ(ierr);
2177 jroman 405
  if(!opb) {
2365 jroman 406
    ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: type of the initial subspace: non-Krylov\n");CHKERRQ(ierr);
1993 eromero 407
  } else {
2365 jroman 408
    ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: type of the initial subspace: Krylov\n");CHKERRQ(ierr);
1993 eromero 409
  }
2331 jroman 410
  ierr = EPSDavidsonGetRestart_Davidson(eps,&opi,&opi0);CHKERRQ(ierr);
2394 jroman 411
  ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: size of the subspace after restarting: %D\n",opi);CHKERRQ(ierr);
412
  ierr = PetscViewerASCIIPrintf(viewer,"  Davidson: number of vectors after restarting from the previous iteration: %D\n",opi0);CHKERRQ(ierr);
1993 eromero 413
  PetscFunctionReturn(0);
414
}
415
 
1992 eromero 416
#undef __FUNCT__  
2324 jroman 417
#define __FUNCT__ "EPSDavidsonSetKrylovStart_Davidson"
418
PetscErrorCode EPSDavidsonSetKrylovStart_Davidson(EPS eps,PetscBool krylovstart)
1980 eromero 419
{
2317 jroman 420
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1619 slepc 421
 
422
  PetscFunctionBegin;
1980 eromero 423
  data->krylovstart = krylovstart;
1619 slepc 424
  PetscFunctionReturn(0);
425
}
426
 
1980 eromero 427
#undef __FUNCT__  
2324 jroman 428
#define __FUNCT__ "EPSDavidsonGetKrylovStart_Davidson"
429
PetscErrorCode EPSDavidsonGetKrylovStart_Davidson(EPS eps,PetscBool *krylovstart)
1980 eromero 430
{
2317 jroman 431
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 432
 
433
  PetscFunctionBegin;
434
  *krylovstart = data->krylovstart;
435
  PetscFunctionReturn(0);
436
}
437
 
438
#undef __FUNCT__  
2324 jroman 439
#define __FUNCT__ "EPSDavidsonSetBlockSize_Davidson"
440
PetscErrorCode EPSDavidsonSetBlockSize_Davidson(EPS eps,PetscInt blocksize)
1980 eromero 441
{
2317 jroman 442
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 443
 
444
  PetscFunctionBegin;
445
  if(blocksize == PETSC_DEFAULT || blocksize == PETSC_DECIDE) blocksize = 1;
446
  if(blocksize <= 0)
2214 jroman 447
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid blocksize value");
1980 eromero 448
  data->blocksize = blocksize;
449
  PetscFunctionReturn(0);
450
}
451
 
452
#undef __FUNCT__  
2324 jroman 453
#define __FUNCT__ "EPSDavidsonGetBlockSize_Davidson"
454
PetscErrorCode EPSDavidsonGetBlockSize_Davidson(EPS eps,PetscInt *blocksize)
1980 eromero 455
{
2317 jroman 456
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 457
 
458
  PetscFunctionBegin;
459
  *blocksize = data->blocksize;
460
  PetscFunctionReturn(0);
461
}
462
 
463
#undef __FUNCT__  
2324 jroman 464
#define __FUNCT__ "EPSDavidsonSetRestart_Davidson"
465
PetscErrorCode EPSDavidsonSetRestart_Davidson(EPS eps,PetscInt minv,PetscInt plusk)
1980 eromero 466
{
2317 jroman 467
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 468
 
469
  PetscFunctionBegin;
470
  if(minv == PETSC_DEFAULT || minv == PETSC_DECIDE) minv = 5;
471
  if(minv <= 0)
2214 jroman 472
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid minv value");
1980 eromero 473
  if(plusk == PETSC_DEFAULT || plusk == PETSC_DECIDE) plusk = 5;
1982 eromero 474
  if(plusk < 0)
2214 jroman 475
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid plusk value");
1980 eromero 476
  data->minv = minv;
477
  data->plusk = plusk;
478
  PetscFunctionReturn(0);
479
}
480
 
481
#undef __FUNCT__  
2324 jroman 482
#define __FUNCT__ "EPSDavidsonGetRestart_Davidson"
483
PetscErrorCode EPSDavidsonGetRestart_Davidson(EPS eps,PetscInt *minv,PetscInt *plusk)
1980 eromero 484
{
2317 jroman 485
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 486
 
487
  PetscFunctionBegin;
488
  *minv = data->minv;
489
  *plusk = data->plusk;
490
  PetscFunctionReturn(0);
491
}
492
 
493
#undef __FUNCT__  
2324 jroman 494
#define __FUNCT__ "EPSDavidsonGetInitialSize_Davidson"
495
PetscErrorCode EPSDavidsonGetInitialSize_Davidson(EPS eps,PetscInt *initialsize)
1980 eromero 496
{
2317 jroman 497
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 498
 
499
  PetscFunctionBegin;
500
  *initialsize = data->initialsize;
501
  PetscFunctionReturn(0);
502
}
503
 
504
#undef __FUNCT__  
2324 jroman 505
#define __FUNCT__ "EPSDavidsonSetInitialSize_Davidson"
506
PetscErrorCode EPSDavidsonSetInitialSize_Davidson(EPS eps,PetscInt initialsize)
1980 eromero 507
{
2317 jroman 508
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 509
 
510
  PetscFunctionBegin;
511
  if(initialsize == PETSC_DEFAULT || initialsize == PETSC_DECIDE) initialsize = 5;
512
  if(initialsize <= 0)
2214 jroman 513
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid initial size value");
1980 eromero 514
  data->initialsize = initialsize;
515
  PetscFunctionReturn(0);
516
}
517
 
1995 eromero 518
#undef __FUNCT__  
2324 jroman 519
#define __FUNCT__ "EPSDavidsonGetFix_Davidson"
520
PetscErrorCode EPSDavidsonGetFix_Davidson(EPS eps,PetscReal *fix)
1995 eromero 521
{
2317 jroman 522
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1980 eromero 523
 
1995 eromero 524
  PetscFunctionBegin;
525
  *fix = data->fix;
526
  PetscFunctionReturn(0);
527
}
528
 
529
#undef __FUNCT__  
2324 jroman 530
#define __FUNCT__ "EPSDavidsonSetFix_Davidson"
531
PetscErrorCode EPSDavidsonSetFix_Davidson(EPS eps,PetscReal fix)
1995 eromero 532
{
2317 jroman 533
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
1995 eromero 534
 
535
  PetscFunctionBegin;
536
  if(fix == PETSC_DEFAULT || fix == PETSC_DECIDE) fix = 0.01;
537
  if(fix < 0.0)
2214 jroman 538
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid fix value");
1995 eromero 539
  data->fix = fix;
540
  PetscFunctionReturn(0);
541
}
542
 
1619 slepc 543
#undef __FUNCT__  
2555 eromero 544
#define __FUNCT__ "EPSDavidsonSetBOrth_Davidson"
545
PetscErrorCode EPSDavidsonSetBOrth_Davidson(EPS eps,PetscBool borth)
546
{
547
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
548
 
549
  PetscFunctionBegin;
550
  data->ipB = borth;
551
  PetscFunctionReturn(0);
552
}
553
 
554
#undef __FUNCT__  
555
#define __FUNCT__ "EPSDavidsonGetBOrth_Davidson"
556
PetscErrorCode EPSDavidsonGetBOrth_Davidson(EPS eps,PetscBool *borth)
557
{
558
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
559
 
560
  PetscFunctionBegin;
561
  *borth = data->ipB;
562
  PetscFunctionReturn(0);
563
}
564
 
2608 eromero 565
#undef __FUNCT__  
566
#define __FUNCT__ "EPSDavidsonSetConstantCorrectionTolerance_Davidson"
2611 eromero 567
PetscErrorCode EPSDavidsonSetConstantCorrectionTolerance_Davidson(EPS eps,PetscBool constant)
2608 eromero 568
{
569
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
2555 eromero 570
 
2608 eromero 571
  PetscFunctionBegin;
2611 eromero 572
  data->dynamic = !constant?PETSC_TRUE:PETSC_FALSE;
2608 eromero 573
  PetscFunctionReturn(0);
574
}
575
 
2555 eromero 576
#undef __FUNCT__  
2608 eromero 577
#define __FUNCT__ "EPSDavidsonGetConstantCorrectionTolerance_Davidson"
2611 eromero 578
PetscErrorCode EPSDavidsonGetConstantCorrectionTolerance_Davidson(EPS eps,PetscBool *constant)
2608 eromero 579
{
580
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
581
 
582
  PetscFunctionBegin;
2611 eromero 583
  *constant = !data->dynamic?PETSC_TRUE:PETSC_FALSE;
2608 eromero 584
  PetscFunctionReturn(0);
585
}
586
 
587
 
588
#undef __FUNCT__  
2611 eromero 589
#define __FUNCT__ "EPSDavidsonSetWindowSizes_Davidson"
590
PetscErrorCode EPSDavidsonSetWindowSizes_Davidson(EPS eps,PetscInt pwindow,PetscInt qwindow)
591
{
592
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
593
 
594
  PetscFunctionBegin;
595
  if(pwindow == PETSC_DEFAULT || pwindow == PETSC_DECIDE) pwindow = 0;
596
  if(pwindow < 0)
597
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid pwindow value");
598
  if(qwindow == PETSC_DEFAULT || qwindow == PETSC_DECIDE) qwindow = 0;
599
  if(qwindow < 0)
600
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid qwindow value");
601
  data->cX_in_proj = qwindow;
602
  data->cX_in_impr = pwindow;
603
  PetscFunctionReturn(0);
604
}
605
 
606
#undef __FUNCT__  
607
#define __FUNCT__ "EPSDavidsonGetWindowSizes_Davidson"
608
PetscErrorCode EPSDavidsonGetWindowSizes_Davidson(EPS eps,PetscInt *pwindow,PetscInt *qwindow)
609
{
610
  EPS_DAVIDSON *data = (EPS_DAVIDSON*)eps->data;
611
 
612
  PetscFunctionBegin;
613
  *pwindow = data->cX_in_impr;
614
  *qwindow = data->cX_in_proj;
615
  PetscFunctionReturn(0);
616
}
617
 
618
 
619
#undef __FUNCT__  
2555 eromero 620
#define __FUNCT__ "EPSComputeVectors_Davidson"
1756 eromero 621
/*
2555 eromero 622
  EPSComputeVectors_Davidson - Compute eigenvectors from the vectors
1756 eromero 623
  provided by the eigensolver. This version is intended for solvers
624
  that provide Schur vectors from the QZ decompositon. Given the partial
625
  Schur decomposition OP*V=V*T, the following steps are performed:
626
      1) compute eigenvectors of (S,T): S*Z=T*Z*D
627
      2) compute eigenvectors of OP: X=V*Z
628
  If left eigenvectors are required then also do Z'*Tl=D*Z', Y=W*Z
629
 */
2555 eromero 630
PetscErrorCode EPSComputeVectors_Davidson(EPS eps)
1756 eromero 631
{
2317 jroman 632
  PetscErrorCode ierr;
633
  EPS_DAVIDSON   *data = (EPS_DAVIDSON*)eps->data;
634
  dvdDashboard   *d = &data->ddb;
2331 jroman 635
  PetscScalar    *pX,*auxS;
2672 eromero 636
  PetscInt       size_auxS;
2022 eromero 637
 
1756 eromero 638
  PetscFunctionBegin;
639
 
2555 eromero 640
  if (d->cS) {
641
    /* Compute the eigenvectors associated to (cS, cT) */
642
    ierr = PetscMalloc(sizeof(PetscScalar)*d->nconv*d->nconv,&pX);CHKERRQ(ierr);
2650 eromero 643
    size_auxS = 6*d->nconv;
2555 eromero 644
    ierr = PetscMalloc(sizeof(PetscScalar)*size_auxS,&auxS);CHKERRQ(ierr);
2672 eromero 645
    ierr = EPSCleanDenseSchur(d->nconv,0,d->cS,d->ldcS,d->cT,d->ldcT,d->ceigi,pX,d->nconv,PETSC_FALSE);CHKERRQ(ierr);
2555 eromero 646
    ierr = dvd_compute_eigenvectors(d->nconv,d->cS,d->ldcS,d->cT,d->ldcT,
647
                                    pX,d->nconv,PETSC_NULL,0,auxS,
648
                                    size_auxS,PETSC_FALSE);CHKERRQ(ierr);
649
 
650
    /* pX[i] <- pX[i] / ||pX[i]|| */
651
    ierr = SlepcDenseNorm(pX,d->nconv,d->nconv,d->nconv,d->ceigi);CHKERRQ(ierr);
652
 
653
    /* V <- cX * pX */
654
    ierr = SlepcUpdateVectorsZ(eps->V,0.0,1.0,d->cX,d->size_cX,pX,
655
                               d->nconv,d->nconv,d->nconv);CHKERRQ(ierr);
656
 
657
    ierr = PetscFree(pX);CHKERRQ(ierr);
658
    ierr = PetscFree(auxS);CHKERRQ(ierr);
659
  }
1762 eromero 660
 
1756 eromero 661
  eps->evecsavailable = PETSC_TRUE;
662
  PetscFunctionReturn(0);
663
}