Subversion Repositories slepc-dev

Rev

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

Rev Author Line No. Line
1298 slepc 1
/*                      
2
 
3
   SLEPc singular value solver: "trlanczos"
4
 
5
   Method: Golub-Kahan-Lanczos bidiagonalization with thick-restart
6
 
1397 slepc 7
   Last update: Jun 2007
1298 slepc 8
 
1376 slepc 9
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1672 slepc 10
   SLEPc - Scalable Library for Eigenvalue Problem Computations
11
   Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain
1376 slepc 12
 
1672 slepc 13
   This file is part of SLEPc.
14
 
15
   SLEPc is free software: you can redistribute it and/or modify it under  the
16
   terms of version 3 of the GNU Lesser General Public License as published by
17
   the Free Software Foundation.
18
 
19
   SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
20
   WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
21
   FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
22
   more details.
23
 
24
   You  should have received a copy of the GNU Lesser General  Public  License
25
   along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
1376 slepc 26
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1298 slepc 27
*/
1376 slepc 28
 
1521 slepc 29
#include "private/svdimpl.h"                /*I "slepcsvd.h" I*/
30
#include "private/ipimpl.h"
1298 slepc 31
#include "slepcblaslapack.h"
32
 
33
typedef struct {
34
  PetscTruth oneside;
35
} SVD_TRLANCZOS;
36
 
37
#undef __FUNCT__  
38
#define __FUNCT__ "SVDSetUp_TRLANCZOS"
39
PetscErrorCode SVDSetUp_TRLANCZOS(SVD svd)
40
{
41
  PetscErrorCode  ierr;
1605 slepc 42
  PetscInt        i,N,nloc;
43
  PetscScalar     *pU;
1298 slepc 44
 
45
  PetscFunctionBegin;
1314 slepc 46
  ierr = SVDMatGetSize(svd,PETSC_NULL,&N);CHKERRQ(ierr);
1595 slepc 47
  if (svd->ncv) { /* ncv set */
48
    if (svd->ncv<svd->nsv) SETERRQ(1,"The value of ncv must be at least nsv");
49
  }
50
  else if (svd->mpd) { /* mpd set */
51
    svd->ncv = PetscMin(N,svd->nsv+svd->mpd);
52
  }
53
  else { /* neither set: defaults depend on nsv being small or large */
54
    if (svd->nsv<500) svd->ncv = PetscMin(N,PetscMax(2*svd->nsv,10));
55
    else { svd->mpd = 500; svd->ncv = PetscMin(N,svd->nsv+svd->mpd); }
56
  }
57
  if (!svd->mpd) svd->mpd = svd->ncv;
58
  if (svd->ncv>svd->nsv+svd->mpd) SETERRQ(1,"The value of ncv must not be larger than nev+mpd");
1594 slepc 59
  if (!svd->max_it)
1314 slepc 60
    svd->max_it = PetscMax(N/svd->ncv,100);
61
  if (svd->ncv!=svd->n) {  
62
    if (svd->U) {
1605 slepc 63
      ierr = VecGetArray(svd->U[0],&pU);CHKERRQ(ierr);
1314 slepc 64
      for (i=0;i<svd->n;i++) { ierr = VecDestroy(svd->U[i]); CHKERRQ(ierr); }
1605 slepc 65
      ierr = PetscFree(pU);CHKERRQ(ierr);
1314 slepc 66
      ierr = PetscFree(svd->U);CHKERRQ(ierr);
67
    }
68
    ierr = PetscMalloc(sizeof(Vec)*svd->ncv,&svd->U);CHKERRQ(ierr);
1605 slepc 69
    ierr = SVDMatGetLocalSize(svd,&nloc,PETSC_NULL);CHKERRQ(ierr);
70
    ierr = PetscMalloc(svd->ncv*nloc*sizeof(PetscScalar),&pU);CHKERRQ(ierr);
71
    for (i=0;i<svd->ncv;i++) {
72
      ierr = VecCreateMPIWithArray(((PetscObject)svd)->comm,nloc,PETSC_DECIDE,pU+i*nloc,&svd->U[i]);CHKERRQ(ierr);
73
    }
1314 slepc 74
  }
1298 slepc 75
  PetscFunctionReturn(0);
76
}
77
 
78
#undef __FUNCT__  
1431 slepc 79
#define __FUNCT__ "SVDOneSideTRLanczosMGS"
1504 slepc 80
static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,PetscScalar* bb,Vec *V,Vec v,Vec* U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work,Vec wv,Vec wu)
1431 slepc 81
{
82
  PetscErrorCode ierr;
83
  PetscReal      a,b;
1504 slepc 84
  PetscInt       i,k=nconv+l;
1431 slepc 85
 
86
  PetscFunctionBegin;
87
  ierr = SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);CHKERRQ(ierr);
88
  if (l>0) {
89
    ierr = VecSet(wu,0.0);CHKERRQ(ierr);
90
    ierr = VecMAXPY(wu,l,bb,U+nconv);CHKERRQ(ierr);
91
    ierr = VecAXPY(U[k],-1.0,wu);CHKERRQ(ierr);
92
  }
93
  ierr = IPNorm(svd->ip,U[k],&a);CHKERRQ(ierr);
94
  ierr = VecScale(U[k],1.0/a);CHKERRQ(ierr);
95
  alpha[0] = a;
96
  for (i=k+1;i<n;i++) {
97
    ierr = SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);CHKERRQ(ierr);
1538 slepc 98
    ierr = IPOrthogonalize(svd->ip,i,PETSC_NULL,V,V[i],work,&b,PETSC_NULL,wv,PETSC_NULL);CHKERRQ(ierr);  
1431 slepc 99
    ierr = VecScale(V[i],1.0/b);CHKERRQ(ierr);
100
    beta[i-k-1] = b;
101
 
102
    ierr = SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);CHKERRQ(ierr);
103
    ierr = VecAXPY(U[i],-b,U[i-1]);CHKERRQ(ierr);
104
    ierr = IPNorm(svd->ip,U[i],&a);CHKERRQ(ierr);
105
    ierr = VecScale(U[i],1.0/a);CHKERRQ(ierr);
106
    alpha[i-k] = a;
107
  }
108
  ierr = SVDMatMult(svd,PETSC_TRUE,U[n-1],v);CHKERRQ(ierr);
1538 slepc 109
  ierr = IPOrthogonalize(svd->ip,n,PETSC_NULL,V,v,work,&b,PETSC_NULL,wv,PETSC_NULL);CHKERRQ(ierr);      
1431 slepc 110
  beta[n-k-1] = b;
111
  PetscFunctionReturn(0);
112
}
113
 
114
#undef __FUNCT__  
1489 slepc 115
#define __FUNCT__ "SVDOneSideTRLanczosCGS"
1504 slepc 116
static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,PetscScalar* bb,Vec *V,Vec v,Vec* U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work,Vec wv,Vec wu)
1328 slepc 117
{
118
  PetscErrorCode ierr;
1414 slepc 119
  PetscReal      a,b,sum,onorm;
120
  PetscScalar    dot;
1504 slepc 121
  PetscInt       i,j,k=nconv+l;
1328 slepc 122
 
123
  PetscFunctionBegin;
124
  ierr = SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);CHKERRQ(ierr);
125
  if (l>0) {
126
    ierr = VecSet(wu,0.0);CHKERRQ(ierr);
127
    ierr = VecMAXPY(wu,l,bb,U+nconv);CHKERRQ(ierr);
128
    ierr = VecAXPY(U[k],-1.0,wu);CHKERRQ(ierr);
129
  }
130
  for (i=k+1;i<n;i++) {
131
    ierr = SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);CHKERRQ(ierr);
1352 slepc 132
    ierr = IPNormBegin(svd->ip,U[i-1],&a);CHKERRQ(ierr);
1414 slepc 133
    if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
134
      ierr = IPInnerProductBegin(svd->ip,V[i],V[i],&dot);CHKERRQ(ierr);
135
    }
1381 slepc 136
    ierr = IPMInnerProductBegin(svd->ip,V[i],i,V,work);CHKERRQ(ierr);
1352 slepc 137
    ierr = IPNormEnd(svd->ip,U[i-1],&a);CHKERRQ(ierr);
1414 slepc 138
    if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
139
      ierr = IPInnerProductEnd(svd->ip,V[i],V[i],&dot);CHKERRQ(ierr);
140
    }
1381 slepc 141
    ierr = IPMInnerProductEnd(svd->ip,V[i],i,V,work);CHKERRQ(ierr);
1328 slepc 142
 
143
    ierr = VecScale(U[i-1],1.0/a);CHKERRQ(ierr);
144
    ierr = VecScale(V[i],1.0/a);CHKERRQ(ierr);
145
    for (j=0;j<i;j++) work[j] = - work[j] / a;
146
    ierr = VecMAXPY(V[i],i,work,V);CHKERRQ(ierr);
147
 
1414 slepc 148
    switch (svd->ip->orthog_ref) {
149
    case IP_ORTH_REFINE_NEVER:
150
      ierr = IPNorm(svd->ip,V[i],&b);CHKERRQ(ierr);
151
      break;      
152
    case IP_ORTH_REFINE_ALWAYS:
153
      ierr = IPOrthogonalizeCGS(svd->ip,i,PETSC_NULL,V,V[i],work,PETSC_NULL,&b,wv);CHKERRQ(ierr);
154
      break;
155
    case IP_ORTH_REFINE_IFNEEDED:
156
      onorm = sqrt(PetscRealPart(dot)) / a;
157
      sum = 0.0;
158
      for (j=0;j<i;j++) {
159
        sum += PetscRealPart(work[j] * PetscConj(work[j]));
160
      }
161
      b = PetscRealPart(dot)/(a*a) - sum;
162
      if (b>0.0) b = sqrt(b);
163
      else {
164
        ierr = IPNorm(svd->ip,V[i],&b);CHKERRQ(ierr);
165
      }
166
      if (b < svd->ip->orthog_eta * onorm) {
167
        ierr = IPOrthogonalizeCGS(svd->ip,i,PETSC_NULL,V,V[i],work,PETSC_NULL,&b,wv);CHKERRQ(ierr);
168
      }
169
      break;
170
    }
171
 
1328 slepc 172
    ierr = VecScale(V[i],1.0/b);CHKERRQ(ierr);
173
 
174
    ierr = SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);CHKERRQ(ierr);
175
    ierr = VecAXPY(U[i],-b,U[i-1]);CHKERRQ(ierr);
176
 
177
    alpha[i-k-1] = a;
178
    beta[i-k-1] = b;
179
  }
180
  ierr = SVDMatMult(svd,PETSC_TRUE,U[n-1],v);CHKERRQ(ierr);
1352 slepc 181
  ierr = IPNormBegin(svd->ip,U[n-1],&a);CHKERRQ(ierr);
1415 slepc 182
  if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
183
    ierr = IPInnerProductBegin(svd->ip,v,v,&dot);CHKERRQ(ierr);
184
  }
1381 slepc 185
  ierr = IPMInnerProductBegin(svd->ip,v,n,V,work);CHKERRQ(ierr);
1352 slepc 186
  ierr = IPNormEnd(svd->ip,U[n-1],&a);CHKERRQ(ierr);
1415 slepc 187
  if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
188
    ierr = IPInnerProductEnd(svd->ip,v,v,&dot);CHKERRQ(ierr);
189
  }
1381 slepc 190
  ierr = IPMInnerProductEnd(svd->ip,v,n,V,work);CHKERRQ(ierr);
1328 slepc 191
 
192
  ierr = VecScale(U[n-1],1.0/a);CHKERRQ(ierr);
193
  ierr = VecScale(v,1.0/a);CHKERRQ(ierr);
194
  for (j=0;j<n;j++) work[j] = - work[j] / a;
195
  ierr = VecMAXPY(v,n,work,V);CHKERRQ(ierr);
196
 
1415 slepc 197
  switch (svd->ip->orthog_ref) {
198
  case IP_ORTH_REFINE_NEVER:
199
    ierr = IPNorm(svd->ip,v,&b);CHKERRQ(ierr);
200
    break;      
201
  case IP_ORTH_REFINE_ALWAYS:
202
    ierr = IPOrthogonalizeCGS(svd->ip,n,PETSC_NULL,V,v,work,PETSC_NULL,&b,wv);CHKERRQ(ierr);
203
    break;
204
  case IP_ORTH_REFINE_IFNEEDED:
205
    onorm = sqrt(PetscRealPart(dot)) / a;
206
    sum = 0.0;
207
    for (j=0;j<i;j++) {
208
      sum += PetscRealPart(work[j] * PetscConj(work[j]));
209
    }
210
    b = PetscRealPart(dot)/(a*a) - sum;
211
    if (b>0.0) b = sqrt(b);
212
    else {
213
      ierr = IPNorm(svd->ip,v,&b);CHKERRQ(ierr);
214
    }
215
    if (b < svd->ip->orthog_eta * onorm) {
216
      ierr = IPOrthogonalizeCGS(svd->ip,n,PETSC_NULL,V,v,work,PETSC_NULL,&b,wv);CHKERRQ(ierr);
217
    }
218
    break;
219
  }
220
 
1328 slepc 221
  alpha[n-k-1] = a;
222
  beta[n-k-1] = b;
223
  PetscFunctionReturn(0);
224
}
225
 
226
#undef __FUNCT__  
1298 slepc 227
#define __FUNCT__ "SVDSolve_TRLANCZOS"
228
PetscErrorCode SVDSolve_TRLANCZOS(SVD svd)
229
{
230
  PetscErrorCode ierr;
231
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
1328 slepc 232
  PetscReal      *alpha,*beta,norm;
1341 slepc 233
  PetscScalar    *b,*Q,*PT,*swork;
1605 slepc 234
  PetscInt       i,j,k,l,m,n,nv;
235
  Vec            v,wv,wu;
1328 slepc 236
  PetscTruth     conv;
1431 slepc 237
  IPOrthogonalizationType orthog;
1298 slepc 238
 
239
  PetscFunctionBegin;
240
  /* allocate working space */
1307 slepc 241
  ierr = PetscMalloc(sizeof(PetscReal)*svd->n,&alpha);CHKERRQ(ierr);
242
  ierr = PetscMalloc(sizeof(PetscReal)*svd->n,&beta);CHKERRQ(ierr);
243
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n,&b);CHKERRQ(ierr);
244
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&Q);CHKERRQ(ierr);
245
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&PT);CHKERRQ(ierr);
1605 slepc 246
#if !defined(PETSC_USE_COMPLEX)
247
  if (svd->which == SVD_SMALLEST) {
248
#endif
249
    ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&swork);CHKERRQ(ierr);
250
#if !defined(PETSC_USE_COMPLEX)
251
  } else {
252
    ierr = PetscMalloc(sizeof(PetscScalar)*svd->n,&swork);CHKERRQ(ierr);
253
  }
254
#endif
1328 slepc 255
  ierr = VecDuplicate(svd->V[0],&v);CHKERRQ(ierr);
256
  ierr = VecDuplicate(svd->V[0],&wv);CHKERRQ(ierr);
257
  ierr = VecDuplicate(svd->U[0],&wu);CHKERRQ(ierr);
1431 slepc 258
  ierr = IPGetOrthogonalization(svd->ip,&orthog,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1298 slepc 259
 
260
  /* normalize start vector */
1328 slepc 261
  ierr = VecCopy(svd->vec_initial,svd->V[0]);CHKERRQ(ierr);
262
  ierr = VecNormalize(svd->V[0],&norm);CHKERRQ(ierr);
1298 slepc 263
 
264
  l = 0;
265
  while (svd->reason == SVD_CONVERGED_ITERATING) {
266
    svd->its++;
267
 
268
    /* inner loop */
1595 slepc 269
    nv = PetscMin(svd->nconv+svd->mpd,svd->n);
1328 slepc 270
    if (lanczos->oneside) {
1431 slepc 271
      if (orthog == IP_MGS_ORTH) {
1595 slepc 272
        ierr = SVDOneSideTRLanczosMGS(svd,alpha,beta,b+svd->nconv,svd->V,v,svd->U,svd->nconv,l,nv,swork,wv,wu);CHKERRQ(ierr);
1431 slepc 273
      } else {
1595 slepc 274
        ierr = SVDOneSideTRLanczosCGS(svd,alpha,beta,b+svd->nconv,svd->V,v,svd->U,svd->nconv,l,nv,swork,wv,wu);CHKERRQ(ierr);
1431 slepc 275
      }
1328 slepc 276
    } else {
1595 slepc 277
      ierr = SVDTwoSideLanczos(svd,alpha,beta,svd->V,v,svd->U,svd->nconv+l,nv,swork,wv,wu);CHKERRQ(ierr);
1298 slepc 278
    }
1595 slepc 279
    ierr = VecScale(v,1.0/beta[nv-svd->nconv-l-1]);CHKERRQ(ierr);
1328 slepc 280
 
1298 slepc 281
    /* compute SVD of general matrix */
1595 slepc 282
    n = nv - svd->nconv;
1298 slepc 283
    /* first l columns */
284
    for (j=0;j<l;j++) {
285
      for (i=0;i<j;i++) Q[j*n+i] = 0.0;    
1328 slepc 286
      Q[j*n+j] = svd->sigma[svd->nconv+j];
1298 slepc 287
      for (i=j+1;i<n;i++) Q[j*n+i] = 0.0;
288
    }
289
    /* l+1 column */
1328 slepc 290
    for (i=0;i<l;i++) Q[l*n+i] = b[i+svd->nconv];
291
    Q[l*n+l] = alpha[0];
1298 slepc 292
    for (i=l+1;i<n;i++) Q[l*n+i] = 0.0;
293
    /* rest of matrix */
294
    for (j=l+1;j<n;j++) {
295
      for (i=0;i<j-1;i++) Q[j*n+i] = 0.0;
1328 slepc 296
      Q[j*n+j-1] = beta[j-l-1];
297
      Q[j*n+j] = alpha[j-l];
1298 slepc 298
      for (i=j+1;i<n;i++) Q[j*n+i] = 0.0;
299
    }
1328 slepc 300
    ierr = SVDDense(n,n,Q,alpha,PETSC_NULL,PT);CHKERRQ(ierr);
1298 slepc 301
 
302
    /* compute error estimates */
1328 slepc 303
    k = 0;
304
    conv = PETSC_TRUE;
1606 slepc 305
    for (i=svd->nconv;i<nv;i++) {
1328 slepc 306
      if (svd->which == SVD_SMALLEST) j = n-i+svd->nconv-1;
307
      else j = i-svd->nconv;
308
      svd->sigma[i] = alpha[j];
309
      b[i] = Q[j*n+n-1]*beta[n-l-1];
310
      svd->errest[i] = PetscAbsScalar(b[i]);
311
      if (alpha[j] > svd->tol) svd->errest[i] /= alpha[j];
312
      if (conv) {
313
        if (svd->errest[i] < svd->tol) k++;
314
        else conv = PETSC_FALSE;
1304 slepc 315
      }
1298 slepc 316
    }
317
 
1328 slepc 318
    /* check convergence and update l */
319
    if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
320
    if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
321
    if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
1606 slepc 322
    else l = PetscMax((nv - svd->nconv - k) / 2,0);
1300 slepc 323
 
1328 slepc 324
    /* compute converged singular vectors and restart vectors*/
1605 slepc 325
#if !defined(PETSC_USE_COMPLEX)
326
    if (svd->which == SVD_SMALLEST) {
327
#endif
1328 slepc 328
    for (i=0;i<k+l;i++) {
329
      if (svd->which == SVD_SMALLEST) j = n-i-1;
330
      else j = i;
1605 slepc 331
      for (m=0;m<n;m++) swork[j*n+m] = PT[m*n+j];
1328 slepc 332
    }
1605 slepc 333
    ierr = SlepcUpdateVectors(n,svd->V+svd->nconv,0,k+l,swork,n,PETSC_FALSE);CHKERRQ(ierr);
334
    for (i=0;i<k+l;i++) {
335
      if (svd->which == SVD_SMALLEST) j = n-i-1;
336
      else j = i;
337
      for (m=0;m<n;m++) swork[j*n+m] = Q[j*n+m];
338
    }
339
    ierr = SlepcUpdateVectors(n,svd->U+svd->nconv,0,k+l,swork,n,PETSC_FALSE);CHKERRQ(ierr);
340
#if !defined(PETSC_USE_COMPLEX)
341
    } else {
342
      ierr = SlepcUpdateVectors(n,svd->V+svd->nconv,0,k+l,PT,n,PETSC_TRUE);CHKERRQ(ierr);
343
      ierr = SlepcUpdateVectors(n,svd->U+svd->nconv,0,k+l,Q,n,PETSC_FALSE);CHKERRQ(ierr);
344
    }
345
#endif
1328 slepc 346
 
1298 slepc 347
    /* copy the last vector to be the next initial vector */
348
    if (svd->reason == SVD_CONVERGED_ITERATING) {
1328 slepc 349
      ierr = VecCopy(v,svd->V[svd->nconv+k+l]);CHKERRQ(ierr);
1298 slepc 350
    }
351
 
1328 slepc 352
    svd->nconv += k;
1595 slepc 353
    SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
1298 slepc 354
  }
355
 
1603 slepc 356
  /* orthonormalize U columns in one side method */
357
  if (lanczos->oneside) {
358
    for (i=0;i<svd->nconv;i++) {
1538 slepc 359
      ierr = IPOrthogonalize(svd->ip,i,PETSC_NULL,svd->U,svd->U[i],PETSC_NULL,&norm,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1489 slepc 360
      ierr = VecScale(svd->U[i],1.0/norm);CHKERRQ(ierr);
361
    }
1298 slepc 362
  }
363
 
364
  /* free working space */
1328 slepc 365
  ierr = VecDestroy(v);CHKERRQ(ierr);
366
  ierr = VecDestroy(wv);CHKERRQ(ierr);
367
  ierr = VecDestroy(wu);CHKERRQ(ierr);
1298 slepc 368
 
369
  ierr = PetscFree(alpha);CHKERRQ(ierr);
370
  ierr = PetscFree(beta);CHKERRQ(ierr);
371
  ierr = PetscFree(b);CHKERRQ(ierr);
372
  ierr = PetscFree(Q);CHKERRQ(ierr);
373
  ierr = PetscFree(PT);CHKERRQ(ierr);
1341 slepc 374
  ierr = PetscFree(swork);CHKERRQ(ierr);
1298 slepc 375
  PetscFunctionReturn(0);
376
}
377
 
378
#undef __FUNCT__  
379
#define __FUNCT__ "SVDSetFromOptions_TRLANCZOS"
380
PetscErrorCode SVDSetFromOptions_TRLANCZOS(SVD svd)
381
{
382
  PetscErrorCode ierr;
383
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
384
 
385
  PetscFunctionBegin;
1422 slepc 386
  ierr = PetscOptionsBegin(((PetscObject)svd)->comm,((PetscObject)svd)->prefix,"TRLANCZOS Singular Value Solver Options","SVD");CHKERRQ(ierr);
1359 slepc 387
  ierr = PetscOptionsTruth("-svd_trlanczos_oneside","Lanczos one-side reorthogonalization","SVDTRLanczosSetOneSide",PETSC_FALSE,&lanczos->oneside,PETSC_NULL);CHKERRQ(ierr);
1298 slepc 388
  ierr = PetscOptionsEnd();CHKERRQ(ierr);
389
  PetscFunctionReturn(0);
390
}
1370 slepc 391
 
1298 slepc 392
EXTERN_C_BEGIN
393
#undef __FUNCT__  
1359 slepc 394
#define __FUNCT__ "SVDTRLanczosSetOneSide_TRLANCZOS"
395
PetscErrorCode SVDTRLanczosSetOneSide_TRLANCZOS(SVD svd,PetscTruth oneside)
1298 slepc 396
{
397
  SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS *)svd->data;
398
 
399
  PetscFunctionBegin;
400
  lanczos->oneside = oneside;
401
  PetscFunctionReturn(0);
402
}
1370 slepc 403
EXTERN_C_END
1298 slepc 404
 
405
#undef __FUNCT__
1359 slepc 406
#define __FUNCT__ "SVDTRLanczosSetOneSide"
1393 slepc 407
/*@
408
   SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
409
   to be used is one-sided or two-sided.
410
 
411
   Collective on SVD
412
 
413
   Input Parameters:
414
+  svd     - singular value solver
415
-  oneside - boolean flag indicating if the method is one-sided or not
416
 
417
   Options Database Key:
418
.  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag
419
 
420
   Note:
421
   By default, a two-sided variant is selected, which is sometimes slightly
422
   more robust. However, the one-sided variant is faster because it avoids
423
   the orthogonalization associated to left singular vectors.
424
 
425
   Level: advanced
426
 
427
.seealso: SVDLanczosSetOneSide()
428
@*/
1359 slepc 429
PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscTruth oneside)
1298 slepc 430
{
431
  PetscErrorCode ierr, (*f)(SVD,PetscTruth);
432
 
433
  PetscFunctionBegin;
434
  PetscValidHeaderSpecific(svd,SVD_COOKIE,1);
1359 slepc 435
  ierr = PetscObjectQueryFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",(void (**)())&f);CHKERRQ(ierr);
1298 slepc 436
  if (f) {
437
    ierr = (*f)(svd,oneside);CHKERRQ(ierr);
438
  }
439
  PetscFunctionReturn(0);
440
}
441
 
442
#undef __FUNCT__  
443
#define __FUNCT__ "SVDView_TRLANCZOS"
444
PetscErrorCode SVDView_TRLANCZOS(SVD svd,PetscViewer viewer)
445
{
446
  PetscErrorCode ierr;
447
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
448
 
449
  PetscFunctionBegin;
450
  ierr = PetscViewerASCIIPrintf(viewer,"Lanczos reorthogonalization: %s\n",lanczos->oneside ? "one-side" : "two-side");CHKERRQ(ierr);
451
  PetscFunctionReturn(0);
452
}
453
 
454
EXTERN_C_BEGIN
455
#undef __FUNCT__  
456
#define __FUNCT__ "SVDCreate_TRLANCZOS"
457
PetscErrorCode SVDCreate_TRLANCZOS(SVD svd)
458
{
459
  PetscErrorCode ierr;
460
  SVD_TRLANCZOS  *lanczos;
461
 
462
  PetscFunctionBegin;
463
  ierr = PetscNew(SVD_TRLANCZOS,&lanczos);CHKERRQ(ierr);
464
  PetscLogObjectMemory(svd,sizeof(SVD_TRLANCZOS));
465
  svd->data                = (void *)lanczos;
466
  svd->ops->setup          = SVDSetUp_TRLANCZOS;
467
  svd->ops->solve          = SVDSolve_TRLANCZOS;
1391 slepc 468
  svd->ops->destroy        = SVDDestroy_Default;
1298 slepc 469
  svd->ops->setfromoptions = SVDSetFromOptions_TRLANCZOS;
470
  svd->ops->view           = SVDView_TRLANCZOS;
471
  lanczos->oneside         = PETSC_FALSE;
1359 slepc 472
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)svd,"SVDTRLanczosSetOneSide_C","SVDTRLanczosSetOneSide_TRLANCZOS",SVDTRLanczosSetOneSide_TRLANCZOS);CHKERRQ(ierr);
1298 slepc 473
  PetscFunctionReturn(0);
474
}
475
EXTERN_C_END