Subversion Repositories slepc-dev

Rev

Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1376 slepc 1
/*
2
       This file implements a wrapper to the BLZPACK package
6 dsic.upv.es!jroman 3
 
1376 slepc 4
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1672 slepc 5
   SLEPc - Scalable Library for Eigenvalue Problem Computations
2116 eromero 6
   Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain
1376 slepc 7
 
1672 slepc 8
   This file is part of SLEPc.
9
 
10
   SLEPc is free software: you can redistribute it and/or modify it under  the
11
   terms of version 3 of the GNU Lesser General Public License as published by
12
   the Free Software Foundation.
13
 
14
   SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
15
   WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
16
   FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
17
   more details.
18
 
19
   You  should have received a copy of the GNU Lesser General  Public  License
20
   along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
1376 slepc 21
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
6 dsic.upv.es!jroman 22
*/
1376 slepc 23
 
2293 jroman 24
#include <private/epsimpl.h>    /*I "slepceps.h" I*/
2298 jroman 25
#include <private/stimpl.h>     /*I "slepcst.h" I*/
2283 jroman 26
#include <../src/eps/impls/external/blzpack/blzpackp.h>
6 dsic.upv.es!jroman 27
 
1947 jroman 28
PetscErrorCode EPSSolve_BLZPACK(EPS);
29
 
114 dsic.upv.es!antodo 30
const char* blzpack_error[33] = {
31
  "",
32
  "illegal data, LFLAG ",
33
  "illegal data, dimension of (U), (V), (X) ",
34
  "illegal data, leading dimension of (U), (V), (X) ",
35
  "illegal data, leading dimension of (EIG) ",
36
  "illegal data, number of required eigenpairs ",
37
  "illegal data, Lanczos algorithm block size ",
38
  "illegal data, maximum number of steps ",
39
  "illegal data, number of starting vectors ",
40
  "illegal data, number of eigenpairs provided ",
41
  "illegal data, problem type flag ",
42
  "illegal data, spectrum slicing flag ",
43
  "illegal data, eigenvectors purification flag ",
44
  "illegal data, level of output ",
45
  "illegal data, output file unit ",
46
  "illegal data, LCOMM (MPI or PVM) ",
47
  "illegal data, dimension of ISTOR ",
48
  "illegal data, convergence threshold ",
49
  "illegal data, dimension of RSTOR ",
50
  "illegal data on at least one PE ",
51
  "ISTOR(3:14) must be equal on all PEs ",
52
  "RSTOR(1:3) must be equal on all PEs ",
53
  "not enough space in ISTOR to start eigensolution ",
54
  "not enough space in RSTOR to start eigensolution ",
55
  "illegal data, number of negative eigenvalues ",
56
  "illegal data, entries of V ",
57
  "illegal data, entries of X ",
58
  "failure in computational subinterval ",
59
  "file I/O error, blzpack.__.BQ ",
60
  "file I/O error, blzpack.__.BX ",
61
  "file I/O error, blzpack.__.Q ",
62
  "file I/O error, blzpack.__.X ",
63
  "parallel interface error "
64
};
65
 
6 dsic.upv.es!jroman 66
#undef __FUNCT__  
67
#define __FUNCT__ "EPSSetUp_BLZPACK"
476 dsic.upv.es!antodo 68
PetscErrorCode EPSSetUp_BLZPACK(EPS eps)
6 dsic.upv.es!jroman 69
{
476 dsic.upv.es!antodo 70
  PetscErrorCode ierr;
1928 jroman 71
  PetscInt       listor, lrstor, ncuv, k1, k2, k3, k4;
476 dsic.upv.es!antodo 72
  EPS_BLZPACK    *blz = (EPS_BLZPACK *)eps->data;
2216 jroman 73
  PetscBool      flg;
476 dsic.upv.es!antodo 74
  KSP            ksp;
75
  PC             pc;
6 dsic.upv.es!jroman 76
 
77
  PetscFunctionBegin;
260 dsic.upv.es!antodo 78
  if (eps->ncv) {
79
    if( eps->ncv < PetscMin(eps->nev+10,eps->nev*2) )
2214 jroman 80
      SETERRQ(((PetscObject)eps)->comm,0,"Warning: BLZpack recommends that ncv be larger than min(nev+10,nev*2)");
260 dsic.upv.es!antodo 81
  }
82
  else eps->ncv = PetscMin(eps->nev+10,eps->nev*2);
1579 slepc 83
  if (eps->mpd) PetscInfo(eps,"Warning: parameter mpd ignored\n");
1928 jroman 84
  if (!eps->max_it) eps->max_it = PetscMax(1000,eps->n);
260 dsic.upv.es!antodo 85
 
6 dsic.upv.es!jroman 86
  if (!eps->ishermitian)
2214 jroman 87
    SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
1229 slepc 88
  if (blz->slice || eps->isgeneralized) {
2092 jroman 89
    ierr = PetscTypeCompare((PetscObject)eps->OP,STSINVERT,&flg);CHKERRQ(ierr);
420 dsic.upv.es!antodo 90
    if (!flg)
2214 jroman 91
      SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Shift-and-invert ST is needed for generalized problems or spectrum slicing");
420 dsic.upv.es!antodo 92
    ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
93
    ierr = PetscTypeCompare((PetscObject)ksp,KSPPREONLY,&flg);CHKERRQ(ierr);
94
    if (!flg)
2214 jroman 95
      SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Preonly KSP is needed for generalized problems or spectrum slicing");
420 dsic.upv.es!antodo 96
    ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
97
    ierr = PetscTypeCompare((PetscObject)pc,PCCHOLESKY,&flg);CHKERRQ(ierr);
98
    if (!flg)
2214 jroman 99
      SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Cholesky PC is needed for generalized problems or spectrum slicing");
420 dsic.upv.es!antodo 100
  }
1942 jroman 101
  if (!eps->which) eps->which = EPS_SMALLEST_REAL;
92 dsic.upv.es!antodo 102
  if (eps->which!=EPS_SMALLEST_REAL)
2214 jroman 103
    SETERRQ(((PetscObject)eps)->comm,1,"Wrong value of eps->which");
6 dsic.upv.es!jroman 104
 
1928 jroman 105
  k1 = PetscMin(eps->n,180);
211 dsic.upv.es!antodo 106
  k2 = blz->block_size;
1928 jroman 107
  k4 = PetscMin(eps->ncv,eps->n);
6 dsic.upv.es!jroman 108
  k3 = 484+k1*(13+k1*2+k2+PetscMax(18,k2+2))+k2*k2*3+k4*2;
109
 
110
  listor = 123+k1*12;
1040 slepc 111
  ierr = PetscFree(blz->istor);CHKERRQ(ierr);
1509 slepc 112
  ierr = PetscMalloc((17+listor)*sizeof(PetscBLASInt),&blz->istor);CHKERRQ(ierr);
1649 slepc 113
  blz->istor[14] = PetscBLASIntCast(listor);
6 dsic.upv.es!jroman 114
 
1928 jroman 115
  if (blz->slice) lrstor = eps->nloc*(k2*4+k1*2+k4)+k3;
116
  else lrstor = eps->nloc*(k2*4+k1)+k3;
1040 slepc 117
  ierr = PetscFree(blz->rstor);CHKERRQ(ierr);
6 dsic.upv.es!jroman 118
  ierr = PetscMalloc((4+lrstor)*sizeof(PetscReal),&blz->rstor);CHKERRQ(ierr);
119
  blz->rstor[3] = lrstor;
120
 
121
  ncuv = PetscMax(3,blz->block_size);
1040 slepc 122
  ierr = PetscFree(blz->u);CHKERRQ(ierr);
1928 jroman 123
  ierr = PetscMalloc(ncuv*eps->nloc*sizeof(PetscScalar),&blz->u);CHKERRQ(ierr);
1040 slepc 124
  ierr = PetscFree(blz->v);CHKERRQ(ierr);
1928 jroman 125
  ierr = PetscMalloc(ncuv*eps->nloc*sizeof(PetscScalar),&blz->v);CHKERRQ(ierr);
6 dsic.upv.es!jroman 126
 
1040 slepc 127
  ierr = PetscFree(blz->eig);CHKERRQ(ierr);
6 dsic.upv.es!jroman 128
  ierr = PetscMalloc(2*eps->ncv*sizeof(PetscReal),&blz->eig);CHKERRQ(ierr);
129
 
1560 slepc 130
  if (eps->extraction) {
131
     ierr = PetscInfo(eps,"Warning: extraction type ignored\n");CHKERRQ(ierr);
1426 slepc 132
  }
133
 
1596 slepc 134
  ierr = EPSAllocateSolution(eps);CHKERRQ(ierr);
1947 jroman 135
 
136
  /* dispatch solve method */
2214 jroman 137
  if (eps->leftvecs) SETERRQ(((PetscObject)eps)->comm,PETSC_ERR_SUP,"Left vectors not supported in this solver");
1947 jroman 138
  eps->ops->solve = EPSSolve_BLZPACK;
6 dsic.upv.es!jroman 139
  PetscFunctionReturn(0);
140
}
141
 
142
#undef __FUNCT__  
143
#define __FUNCT__ "EPSSolve_BLZPACK"
476 dsic.upv.es!antodo 144
PetscErrorCode EPSSolve_BLZPACK(EPS eps)
6 dsic.upv.es!jroman 145
{
476 dsic.upv.es!antodo 146
  PetscErrorCode ierr;
1089 slepc 147
  EPS_BLZPACK    *blz = (EPS_BLZPACK *)eps->data;
1928 jroman 148
  PetscInt       nn;
1509 slepc 149
  PetscBLASInt   i, nneig, lflag, nvopu;      
476 dsic.upv.es!antodo 150
  Vec            x, y;                          
151
  PetscScalar    sigma,*pV;                      
152
  Mat            A;                              
153
  KSP            ksp;                            
154
  PC             pc;                            
6 dsic.upv.es!jroman 155
 
156
  PetscFunctionBegin;
1928 jroman 157
  ierr = VecCreateMPIWithArray(((PetscObject)eps)->comm,eps->nloc,PETSC_DECIDE,PETSC_NULL,&x);CHKERRQ(ierr);
158
  ierr = VecCreateMPIWithArray(((PetscObject)eps)->comm,eps->nloc,PETSC_DECIDE,PETSC_NULL,&y);CHKERRQ(ierr);
6 dsic.upv.es!jroman 159
  ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
160
 
1229 slepc 161
  if (eps->isgeneralized && !blz->slice) {
162
    ierr = STGetShift(eps->OP,&sigma);CHKERRQ(ierr); /* shift of origin */
163
    blz->rstor[0]  = sigma;        /* lower limit of eigenvalue interval */
164
    blz->rstor[1]  = sigma;        /* upper limit of eigenvalue interval */
165
  } else {
166
    sigma = 0.0;
167
    blz->rstor[0]  = blz->initial; /* lower limit of eigenvalue interval */
168
    blz->rstor[1]  = blz->final;   /* upper limit of eigenvalue interval */
169
  }
420 dsic.upv.es!antodo 170
  nneig = 0;                     /* no. of eigs less than sigma */
171
 
1928 jroman 172
  blz->istor[0]  = PetscBLASIntCast(eps->nloc); /* number of rows of U, V, X*/
173
  blz->istor[1]  = PetscBLASIntCast(eps->nloc); /* leading dimension of U, V, X */
1649 slepc 174
  blz->istor[2]  = PetscBLASIntCast(eps->nev); /* number of required eigenpairs */
175
  blz->istor[3]  = PetscBLASIntCast(eps->ncv); /* number of working eigenpairs */
6 dsic.upv.es!jroman 176
  blz->istor[4]  = blz->block_size;    /* number of vectors in a block */
422 dsic.upv.es!antodo 177
  blz->istor[5]  = blz->nsteps;  /* maximun number of steps per run */
6 dsic.upv.es!jroman 178
  blz->istor[6]  = 1;            /* number of starting vectors as input */
179
  blz->istor[7]  = 0;            /* number of eigenpairs given as input */
1229 slepc 180
  blz->istor[8]  = (blz->slice || eps->isgeneralized) ? 1 : 0;   /* problem type */
420 dsic.upv.es!antodo 181
  blz->istor[9]  = blz->slice;   /* spectrum slicing */
1229 slepc 182
  blz->istor[10] = eps->isgeneralized ? 1 : 0;   /* solutions refinement (purify) */
420 dsic.upv.es!antodo 183
  blz->istor[11] = 0;            /* level of printing */
6 dsic.upv.es!jroman 184
  blz->istor[12] = 6;            /* file unit for output */
1649 slepc 185
  blz->istor[13] = PetscBLASIntCast(MPI_Comm_c2f(((PetscObject)eps)->comm)); /* communicator */
6 dsic.upv.es!jroman 186
 
187
  blz->rstor[2]  = eps->tol;     /* threshold for convergence */
188
 
189
  lflag = 0;           /* reverse communication interface flag */
190
 
422 dsic.upv.es!antodo 191
  do {
6 dsic.upv.es!jroman 192
    BLZpack_( blz->istor, blz->rstor, &sigma, &nneig, blz->u, blz->v,
193
              &lflag, &nvopu, blz->eig, pV );
194
 
422 dsic.upv.es!antodo 195
    switch (lflag) {
196
    case 1:
6 dsic.upv.es!jroman 197
      /* compute v = OP u */
198
      for (i=0;i<nvopu;i++) {
1928 jroman 199
        ierr = VecPlaceArray( x, blz->u+i*eps->nloc );CHKERRQ(ierr);
200
        ierr = VecPlaceArray( y, blz->v+i*eps->nloc );CHKERRQ(ierr);
1229 slepc 201
        if (blz->slice || eps->isgeneralized) {
202
          ierr = STAssociatedKSPSolve( eps->OP, x, y );CHKERRQ(ierr);
2316 jroman 203
        } else {
6 dsic.upv.es!jroman 204
          ierr = STApply( eps->OP, x, y ); CHKERRQ(ierr);
2316 jroman 205
        }
1755 antodo 206
        ierr = IPOrthogonalize(eps->ip,0,PETSC_NULL,eps->nds,PETSC_NULL,eps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
850 dsic.upv.es!antodo 207
        ierr = VecResetArray(x);CHKERRQ(ierr);
2316 jroman 208
        ierr = VecResetArray(y);CHKERRQ(ierr);
6 dsic.upv.es!jroman 209
      }
422 dsic.upv.es!antodo 210
      /* monitor */
211
      eps->nconv  = BLZistorr_(blz->istor,"NTEIG",5);
2313 jroman 212
      ierr = EPSMonitor(eps,eps->its,eps->nconv,
422 dsic.upv.es!antodo 213
        blz->rstor+BLZistorr_(blz->istor,"IRITZ",5),
214
        eps->eigi,
215
        blz->rstor+BLZistorr_(blz->istor,"IRITZ",5)+BLZistorr_(blz->istor,"JT",2),
2313 jroman 216
        BLZistorr_(blz->istor,"NRITZ",5));CHKERRQ(ierr);
624 dsic.upv.es!antodo 217
      eps->its = eps->its + 1;
422 dsic.upv.es!antodo 218
      if (eps->its >= eps->max_it || eps->nconv >= eps->nev) lflag = 5;
219
      break;
220
    case 2:  
6 dsic.upv.es!jroman 221
      /* compute v = B u */
222
      for (i=0;i<nvopu;i++) {
1928 jroman 223
        ierr = VecPlaceArray( x, blz->u+i*eps->nloc );CHKERRQ(ierr);
224
        ierr = VecPlaceArray( y, blz->v+i*eps->nloc );CHKERRQ(ierr);
1358 slepc 225
        ierr = IPApplyMatrix(eps->ip, x, y ); CHKERRQ(ierr);
850 dsic.upv.es!antodo 226
        ierr = VecResetArray(x);CHKERRQ(ierr);
2316 jroman 227
        ierr = VecResetArray(y);CHKERRQ(ierr);
6 dsic.upv.es!jroman 228
      }
422 dsic.upv.es!antodo 229
      break;
230
    case 3:  
6 dsic.upv.es!jroman 231
      /* update shift */
1229 slepc 232
      PetscInfo1(eps,"Factorization update (sigma=%g)\n",sigma);
420 dsic.upv.es!antodo 233
      ierr = STSetShift(eps->OP,sigma);CHKERRQ(ierr);
234
      ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
235
      ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
1649 slepc 236
      ierr = PCFactorGetMatrix(pc,&A);CHKERRQ(ierr);
1089 slepc 237
      ierr = MatGetInertia(A,&nn,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1649 slepc 238
      nneig = PetscBLASIntCast(nn);
422 dsic.upv.es!antodo 239
      break;
240
    case 4:  
6 dsic.upv.es!jroman 241
      /* copy the initial vector */
242
      ierr = VecPlaceArray(x,blz->v);CHKERRQ(ierr);
1229 slepc 243
      ierr = EPSGetStartVector(eps,0,x,PETSC_NULL);CHKERRQ(ierr);
850 dsic.upv.es!antodo 244
      ierr = VecResetArray(x);CHKERRQ(ierr);
422 dsic.upv.es!antodo 245
      break;
6 dsic.upv.es!jroman 246
    }
422 dsic.upv.es!antodo 247
 
248
  } while (lflag > 0);
6 dsic.upv.es!jroman 249
 
250
  ierr = VecRestoreArray( eps->V[0], &pV ); CHKERRQ(ierr);
251
 
252
  eps->nconv  = BLZistorr_(blz->istor,"NTEIG",5);
253
  eps->reason = EPS_CONVERGED_TOL;
254
 
255
  for (i=0;i<eps->nconv;i++) {
256
    eps->eigr[i]=blz->eig[i];
257
  }
258
 
114 dsic.upv.es!antodo 259
  if (lflag!=0) {
260
    char msg[2048] = "";
261
    for (i = 0; i < 33; i++) {
134 dsic.upv.es!antodo 262
      if (blz->istor[15] & (1 << i)) PetscStrcat(msg, blzpack_error[i]);
114 dsic.upv.es!antodo 263
    }
2214 jroman 264
    SETERRQ2(((PetscObject)eps)->comm,PETSC_ERR_LIB,"Error in BLZPACK (code=%d): '%s'",blz->istor[15], msg);
114 dsic.upv.es!antodo 265
  }
2305 jroman 266
  ierr = VecDestroy(&x);CHKERRQ(ierr);
267
  ierr = VecDestroy(&y);CHKERRQ(ierr);
6 dsic.upv.es!jroman 268
  PetscFunctionReturn(0);
269
}
270
 
271
#undef __FUNCT__  
420 dsic.upv.es!antodo 272
#define __FUNCT__ "EPSBackTransform_BLZPACK"
476 dsic.upv.es!antodo 273
PetscErrorCode EPSBackTransform_BLZPACK(EPS eps)
420 dsic.upv.es!antodo 274
{
476 dsic.upv.es!antodo 275
  PetscErrorCode ierr;
276
  EPS_BLZPACK    *blz = (EPS_BLZPACK *)eps->data;
420 dsic.upv.es!antodo 277
 
278
  PetscFunctionBegin;
1229 slepc 279
  if (!blz->slice && !eps->isgeneralized) {
442 dsic.upv.es!antodo 280
    ierr = EPSBackTransform_Default(eps);CHKERRQ(ierr);
281
  }
420 dsic.upv.es!antodo 282
  PetscFunctionReturn(0);
283
}
284
 
285
#undef __FUNCT__  
6 dsic.upv.es!jroman 286
#define __FUNCT__ "EPSDestroy_BLZPACK"
476 dsic.upv.es!antodo 287
PetscErrorCode EPSDestroy_BLZPACK(EPS eps)
6 dsic.upv.es!jroman 288
{
476 dsic.upv.es!antodo 289
  PetscErrorCode ierr;
290
  EPS_BLZPACK    *blz = (EPS_BLZPACK *)eps->data;
6 dsic.upv.es!jroman 291
 
292
  PetscFunctionBegin;
2213 jroman 293
  PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
1040 slepc 294
  ierr = PetscFree(blz->istor);CHKERRQ(ierr);
295
  ierr = PetscFree(blz->rstor);CHKERRQ(ierr);
296
  ierr = PetscFree(blz->u);CHKERRQ(ierr);
297
  ierr = PetscFree(blz->v);CHKERRQ(ierr);
298
  ierr = PetscFree(blz->eig);CHKERRQ(ierr);
299
  ierr = PetscFree(eps->data);CHKERRQ(ierr);
1596 slepc 300
  ierr = EPSFreeSolution(eps);CHKERRQ(ierr);
1925 jroman 301
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetBlockSize_C","",PETSC_NULL);CHKERRQ(ierr);
302
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetInterval_C","",PETSC_NULL);CHKERRQ(ierr);
303
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetNSteps_C","",PETSC_NULL);CHKERRQ(ierr);
6 dsic.upv.es!jroman 304
  PetscFunctionReturn(0);
305
}
306
 
307
#undef __FUNCT__  
308
#define __FUNCT__ "EPSView_BLZPACK"
476 dsic.upv.es!antodo 309
PetscErrorCode EPSView_BLZPACK(EPS eps,PetscViewer viewer)
6 dsic.upv.es!jroman 310
{
476 dsic.upv.es!antodo 311
  PetscErrorCode ierr;
312
  EPS_BLZPACK    *blz = (EPS_BLZPACK *) eps->data;
2216 jroman 313
  PetscBool      isascii;
6 dsic.upv.es!jroman 314
 
315
  PetscFunctionBegin;
2215 jroman 316
  ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
6 dsic.upv.es!jroman 317
  if (!isascii) {
2214 jroman 318
    SETERRQ1(((PetscObject)eps)->comm,1,"Viewer type %s not supported for EPSBLZPACK",((PetscObject)viewer)->type_name);
6 dsic.upv.es!jroman 319
  }
320
  ierr = PetscViewerASCIIPrintf(viewer,"block size of the block-Lanczos algorithm: %d\n",blz->block_size);CHKERRQ(ierr);
321
  ierr = PetscViewerASCIIPrintf(viewer,"computational interval: [%f,%f]\n",blz->initial,blz->final);CHKERRQ(ierr);
322
  PetscFunctionReturn(0);
323
}
324
 
325
#undef __FUNCT__  
326
#define __FUNCT__ "EPSSetFromOptions_BLZPACK"
476 dsic.upv.es!antodo 327
PetscErrorCode EPSSetFromOptions_BLZPACK(EPS eps)
6 dsic.upv.es!jroman 328
{
476 dsic.upv.es!antodo 329
  PetscErrorCode ierr;
330
  EPS_BLZPACK    *blz = (EPS_BLZPACK *)eps->data;
1089 slepc 331
  PetscInt       bs,n;
476 dsic.upv.es!antodo 332
  PetscReal      interval[2];
2216 jroman 333
  PetscBool      flg;
476 dsic.upv.es!antodo 334
  KSP            ksp;
335
  PC             pc;
6 dsic.upv.es!jroman 336
 
337
  PetscFunctionBegin;
2102 eromero 338
  ierr = PetscOptionsBegin(((PetscObject)eps)->comm,((PetscObject)eps)->prefix,"BLZPACK Options","EPS");CHKERRQ(ierr);
6 dsic.upv.es!jroman 339
 
444 dsic.upv.es!antodo 340
  bs = blz->block_size;
341
  ierr = PetscOptionsInt("-eps_blzpack_block_size","Block size","EPSBlzpackSetBlockSize",bs,&bs,&flg);CHKERRQ(ierr);
342
  if (flg) {ierr = EPSBlzpackSetBlockSize(eps,bs);CHKERRQ(ierr);}
6 dsic.upv.es!jroman 343
 
444 dsic.upv.es!antodo 344
  n = blz->nsteps;
345
  ierr = PetscOptionsInt("-eps_blzpack_nsteps","Number of steps","EPSBlzpackSetNSteps",n,&n,&flg);CHKERRQ(ierr);
346
  if (flg) {ierr = EPSBlzpackSetNSteps(eps,n);CHKERRQ(ierr);}
422 dsic.upv.es!antodo 347
 
444 dsic.upv.es!antodo 348
  interval[0] = blz->initial;
349
  interval[1] = blz->final;
350
  n = 2;
351
  ierr = PetscOptionsRealArray("-eps_blzpack_interval","Computational interval","EPSBlzpackSetInterval",interval,&n,&flg);CHKERRQ(ierr);
352
  if (flg) {
353
    if (n==1) interval[1]=interval[0];
354
    ierr = EPSBlzpackSetInterval(eps,interval[0],interval[1]);CHKERRQ(ierr);
355
  }
6 dsic.upv.es!jroman 356
 
1229 slepc 357
  if (blz->slice || eps->isgeneralized) {
2092 jroman 358
    ierr = STSetType(eps->OP,STSINVERT);CHKERRQ(ierr);
444 dsic.upv.es!antodo 359
    ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
360
    ierr = KSPSetType(ksp,KSPPREONLY);CHKERRQ(ierr);
361
    ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
362
    ierr = PCSetType(pc,PCCHOLESKY);CHKERRQ(ierr);
363
  }
364
 
2102 eromero 365
  ierr = PetscOptionsEnd();CHKERRQ(ierr);
6 dsic.upv.es!jroman 366
  PetscFunctionReturn(0);
367
}
368
 
369
EXTERN_C_BEGIN
370
#undef __FUNCT__  
371
#define __FUNCT__ "EPSBlzpackSetBlockSize_BLZPACK"
1509 slepc 372
PetscErrorCode EPSBlzpackSetBlockSize_BLZPACK(EPS eps,PetscInt bs)
6 dsic.upv.es!jroman 373
{
476 dsic.upv.es!antodo 374
  EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
6 dsic.upv.es!jroman 375
 
376
  PetscFunctionBegin;
211 dsic.upv.es!antodo 377
  if (bs == PETSC_DEFAULT) blz->block_size = 3;
378
  else if (bs <= 0) {
2214 jroman 379
    SETERRQ(((PetscObject)eps)->comm,1, "Incorrect block size");
1649 slepc 380
  } else blz->block_size = PetscBLASIntCast(bs);
6 dsic.upv.es!jroman 381
  PetscFunctionReturn(0);
382
}
383
EXTERN_C_END
384
 
385
#undef __FUNCT__  
386
#define __FUNCT__ "EPSBlzpackSetBlockSize"
387
/*@
388
   EPSBlzpackSetBlockSize - Sets the block size for the BLZPACK package.
389
 
390
   Collective on EPS
391
 
392
   Input Parameters:
393
+  eps - the eigenproblem solver context
394
-  bs - block size
395
 
396
   Options Database Key:
397
.  -eps_blzpack_block_size - Sets the value of the block size
398
 
399
   Level: advanced
400
 
553 dsic.upv.es!jroman 401
.seealso: EPSBlzpackSetInterval()
6 dsic.upv.es!jroman 402
@*/
1509 slepc 403
PetscErrorCode EPSBlzpackSetBlockSize(EPS eps,PetscInt bs)
6 dsic.upv.es!jroman 404
{
2221 jroman 405
  PetscErrorCode ierr;
6 dsic.upv.es!jroman 406
 
407
  PetscFunctionBegin;
2213 jroman 408
  PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
2326 jroman 409
  PetscValidLogicalCollectiveInt(eps,bs,2);
2221 jroman 410
  ierr = PetscTryMethod(eps,"EPSBlzpackSetBlockSize_C",(EPS,PetscInt),(eps,bs));CHKERRQ(ierr);
6 dsic.upv.es!jroman 411
  PetscFunctionReturn(0);
412
}
413
 
414
EXTERN_C_BEGIN
415
#undef __FUNCT__  
416
#define __FUNCT__ "EPSBlzpackSetInterval_BLZPACK"
476 dsic.upv.es!antodo 417
PetscErrorCode EPSBlzpackSetInterval_BLZPACK(EPS eps,PetscReal initial,PetscReal final)
6 dsic.upv.es!jroman 418
{
1229 slepc 419
  PetscErrorCode ierr;
476 dsic.upv.es!antodo 420
  EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
6 dsic.upv.es!jroman 421
 
422
  PetscFunctionBegin;
423
  blz->initial    = initial;
424
  blz->final      = final;
420 dsic.upv.es!antodo 425
  blz->slice      = 1;
1229 slepc 426
  ierr = STSetShift(eps->OP,initial);CHKERRQ(ierr);
6 dsic.upv.es!jroman 427
  PetscFunctionReturn(0);
428
}
429
EXTERN_C_END
430
 
431
#undef __FUNCT__  
432
#define __FUNCT__ "EPSBlzpackSetInterval"
433
/*@
434
   EPSBlzpackSetInterval - Sets the computational interval for the BLZPACK
435
   package.
436
 
437
   Collective on EPS
438
 
439
   Input Parameters:
440
+  eps     - the eigenproblem solver context
441
.  initial - lower bound of the interval
442
-  final   - upper bound of the interval
443
 
444
   Options Database Key:
445
.  -eps_blzpack_interval - Sets the bounds of the interval (two values
446
   separated by commas)
447
 
448
   Note:
449
   The following possibilities are accepted (see Blzpack user's guide for
450
   details).
451
     initial>final: start seeking for eigenpairs in the upper bound
452
     initial<final: start in the lower bound
453
     initial=final: run around a single value (no interval)
454
 
455
   Level: advanced
456
 
457
.seealso: EPSBlzpackSetBlockSize()
458
@*/
476 dsic.upv.es!antodo 459
PetscErrorCode EPSBlzpackSetInterval(EPS eps,PetscReal initial,PetscReal final)
6 dsic.upv.es!jroman 460
{
2221 jroman 461
  PetscErrorCode ierr;
6 dsic.upv.es!jroman 462
 
463
  PetscFunctionBegin;
2213 jroman 464
  PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
2326 jroman 465
  PetscValidLogicalCollectiveReal(eps,initial,2);
466
  PetscValidLogicalCollectiveReal(eps,final,3);
2221 jroman 467
  ierr = PetscTryMethod(eps,"EPSBlzpackSetInterval_C",(EPS,PetscReal,PetscReal),(eps,initial,final));CHKERRQ(ierr);
6 dsic.upv.es!jroman 468
  PetscFunctionReturn(0);
469
}
470
 
471
EXTERN_C_BEGIN
472
#undef __FUNCT__  
422 dsic.upv.es!antodo 473
#define __FUNCT__ "EPSBlzpackSetNSteps_BLZPACK"
1509 slepc 474
PetscErrorCode EPSBlzpackSetNSteps_BLZPACK(EPS eps,PetscInt nsteps)
422 dsic.upv.es!antodo 475
{
476 dsic.upv.es!antodo 476
  EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
422 dsic.upv.es!antodo 477
 
478
  PetscFunctionBegin;
1649 slepc 479
  if (nsteps == PETSC_DEFAULT) blz->nsteps = 0;
480
  else { blz->nsteps = PetscBLASIntCast(nsteps); }
422 dsic.upv.es!antodo 481
  PetscFunctionReturn(0);
482
}
483
EXTERN_C_END
484
 
485
#undef __FUNCT__  
486
#define __FUNCT__ "EPSBlzpackSetNSteps"
487
/*@
488
   EPSBlzpackSetNSteps - Sets the maximum number of steps per run for the BLZPACK
489
   package.
490
 
491
   Collective on EPS
492
 
493
   Input Parameters:
494
+  eps     - the eigenproblem solver context
495
-  nsteps  - maximum number of steps
496
 
497
   Options Database Key:
424 dsic.upv.es!antodo 498
.  -eps_blzpack_nsteps - Sets the maximum number of steps per run
422 dsic.upv.es!antodo 499
 
500
   Level: advanced
501
 
502
@*/
1509 slepc 503
PetscErrorCode EPSBlzpackSetNSteps(EPS eps,PetscInt nsteps)
422 dsic.upv.es!antodo 504
{
2221 jroman 505
  PetscErrorCode ierr;
422 dsic.upv.es!antodo 506
 
507
  PetscFunctionBegin;
2213 jroman 508
  PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
2326 jroman 509
  PetscValidLogicalCollectiveInt(eps,nsteps,2);
2221 jroman 510
  ierr = PetscTryMethod(eps,"EPSBlzpackSetNSteps_C",(EPS,PetscInt),(eps,nsteps));CHKERRQ(ierr);
422 dsic.upv.es!antodo 511
  PetscFunctionReturn(0);
512
}
513
 
514
EXTERN_C_BEGIN
515
#undef __FUNCT__  
6 dsic.upv.es!jroman 516
#define __FUNCT__ "EPSCreate_BLZPACK"
476 dsic.upv.es!antodo 517
PetscErrorCode EPSCreate_BLZPACK(EPS eps)
6 dsic.upv.es!jroman 518
{
476 dsic.upv.es!antodo 519
  PetscErrorCode ierr;
520
  EPS_BLZPACK    *blzpack;
6 dsic.upv.es!jroman 521
 
522
  PetscFunctionBegin;
523
  ierr = PetscNew(EPS_BLZPACK,&blzpack);CHKERRQ(ierr);
524
  PetscLogObjectMemory(eps,sizeof(EPS_BLZPACK));
525
  eps->data                      = (void *) blzpack;
526
  eps->ops->setup                = EPSSetUp_BLZPACK;
503 dsic.upv.es!antodo 527
  eps->ops->setfromoptions       = EPSSetFromOptions_BLZPACK;
6 dsic.upv.es!jroman 528
  eps->ops->destroy              = EPSDestroy_BLZPACK;
529
  eps->ops->view                 = EPSView_BLZPACK;
420 dsic.upv.es!antodo 530
  eps->ops->backtransform        = EPSBackTransform_BLZPACK;
503 dsic.upv.es!antodo 531
  eps->ops->computevectors       = EPSComputeVectors_Default;
6 dsic.upv.es!jroman 532
 
211 dsic.upv.es!antodo 533
  blzpack->block_size = 3;
6 dsic.upv.es!jroman 534
  blzpack->initial = 0.0;
535
  blzpack->final = 0.0;
420 dsic.upv.es!antodo 536
  blzpack->slice = 0;
422 dsic.upv.es!antodo 537
  blzpack->nsteps = 0;
538
 
539
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetBlockSize_C","EPSBlzpackSetBlockSize_BLZPACK",EPSBlzpackSetBlockSize_BLZPACK);CHKERRQ(ierr);
6 dsic.upv.es!jroman 540
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetInterval_C","EPSBlzpackSetInterval_BLZPACK",EPSBlzpackSetInterval_BLZPACK);CHKERRQ(ierr);
422 dsic.upv.es!antodo 541
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetNSteps_C","EPSBlzpackSetNSteps_BLZPACK",EPSBlzpackSetNSteps_BLZPACK);CHKERRQ(ierr);
6 dsic.upv.es!jroman 542
  PetscFunctionReturn(0);
543
}
544
EXTERN_C_END