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
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"
1755 antodo 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)
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) {
1755 antodo 89
    ierr = SlepcVecMAXPBY(U[k],1.0,-1.0,l,bb,U+nconv);CHKERRQ(ierr);
1431 slepc 90
  }
91
  ierr = IPNorm(svd->ip,U[k],&a);CHKERRQ(ierr);
92
  ierr = VecScale(U[k],1.0/a);CHKERRQ(ierr);
93
  alpha[0] = a;
94
  for (i=k+1;i<n;i++) {
95
    ierr = SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);CHKERRQ(ierr);
1755 antodo 96
    ierr = IPOrthogonalize(svd->ip,0,PETSC_NULL,i,PETSC_NULL,V,V[i],work,&b,PETSC_NULL);CHKERRQ(ierr);  
1431 slepc 97
    ierr = VecScale(V[i],1.0/b);CHKERRQ(ierr);
98
    beta[i-k-1] = b;
99
 
100
    ierr = SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);CHKERRQ(ierr);
101
    ierr = VecAXPY(U[i],-b,U[i-1]);CHKERRQ(ierr);
102
    ierr = IPNorm(svd->ip,U[i],&a);CHKERRQ(ierr);
103
    ierr = VecScale(U[i],1.0/a);CHKERRQ(ierr);
104
    alpha[i-k] = a;
105
  }
106
  ierr = SVDMatMult(svd,PETSC_TRUE,U[n-1],v);CHKERRQ(ierr);
1755 antodo 107
  ierr = IPOrthogonalize(svd->ip,0,PETSC_NULL,n,PETSC_NULL,V,v,work,&b,PETSC_NULL);CHKERRQ(ierr);      
1431 slepc 108
  beta[n-k-1] = b;
109
  PetscFunctionReturn(0);
110
}
111
 
112
#undef __FUNCT__  
1489 slepc 113
#define __FUNCT__ "SVDOneSideTRLanczosCGS"
1755 antodo 114
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)
1328 slepc 115
{
116
  PetscErrorCode ierr;
1414 slepc 117
  PetscReal      a,b,sum,onorm;
118
  PetscScalar    dot;
1504 slepc 119
  PetscInt       i,j,k=nconv+l;
1328 slepc 120
 
121
  PetscFunctionBegin;
122
  ierr = SVDMatMult(svd,PETSC_FALSE,V[k],U[k]);CHKERRQ(ierr);
123
  if (l>0) {
1755 antodo 124
    ierr = SlepcVecMAXPBY(U[k],1.0,-1.0,l,bb,U+nconv);CHKERRQ(ierr);
1328 slepc 125
  }
126
  for (i=k+1;i<n;i++) {
127
    ierr = SVDMatMult(svd,PETSC_TRUE,U[i-1],V[i]);CHKERRQ(ierr);
1352 slepc 128
    ierr = IPNormBegin(svd->ip,U[i-1],&a);CHKERRQ(ierr);
1414 slepc 129
    if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
130
      ierr = IPInnerProductBegin(svd->ip,V[i],V[i],&dot);CHKERRQ(ierr);
131
    }
1381 slepc 132
    ierr = IPMInnerProductBegin(svd->ip,V[i],i,V,work);CHKERRQ(ierr);
1352 slepc 133
    ierr = IPNormEnd(svd->ip,U[i-1],&a);CHKERRQ(ierr);
1414 slepc 134
    if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
135
      ierr = IPInnerProductEnd(svd->ip,V[i],V[i],&dot);CHKERRQ(ierr);
136
    }
1381 slepc 137
    ierr = IPMInnerProductEnd(svd->ip,V[i],i,V,work);CHKERRQ(ierr);
1328 slepc 138
 
139
    ierr = VecScale(U[i-1],1.0/a);CHKERRQ(ierr);
1755 antodo 140
    for (j=0;j<i;j++) work[j] = work[j] / a;
141
    ierr = SlepcVecMAXPBY(V[i],1.0/a,-1.0,i,work,V);CHKERRQ(ierr);
1328 slepc 142
 
1414 slepc 143
    switch (svd->ip->orthog_ref) {
144
    case IP_ORTH_REFINE_NEVER:
145
      ierr = IPNorm(svd->ip,V[i],&b);CHKERRQ(ierr);
146
      break;      
147
    case IP_ORTH_REFINE_ALWAYS:
1755 antodo 148
      ierr = IPOrthogonalizeCGS1(svd->ip,0,PETSC_NULL,i,PETSC_NULL,V,V[i],work,PETSC_NULL,&b);CHKERRQ(ierr);
1414 slepc 149
      break;
150
    case IP_ORTH_REFINE_IFNEEDED:
151
      onorm = sqrt(PetscRealPart(dot)) / a;
152
      sum = 0.0;
153
      for (j=0;j<i;j++) {
154
        sum += PetscRealPart(work[j] * PetscConj(work[j]));
155
      }
156
      b = PetscRealPart(dot)/(a*a) - sum;
157
      if (b>0.0) b = sqrt(b);
158
      else {
159
        ierr = IPNorm(svd->ip,V[i],&b);CHKERRQ(ierr);
160
      }
161
      if (b < svd->ip->orthog_eta * onorm) {
1755 antodo 162
        ierr = IPOrthogonalizeCGS1(svd->ip,0,PETSC_NULL,i,PETSC_NULL,V,V[i],work,PETSC_NULL,&b);CHKERRQ(ierr);
1414 slepc 163
      }
164
      break;
165
    }
166
 
1328 slepc 167
    ierr = VecScale(V[i],1.0/b);CHKERRQ(ierr);
168
 
169
    ierr = SVDMatMult(svd,PETSC_FALSE,V[i],U[i]);CHKERRQ(ierr);
170
    ierr = VecAXPY(U[i],-b,U[i-1]);CHKERRQ(ierr);
171
 
172
    alpha[i-k-1] = a;
173
    beta[i-k-1] = b;
174
  }
175
  ierr = SVDMatMult(svd,PETSC_TRUE,U[n-1],v);CHKERRQ(ierr);
1352 slepc 176
  ierr = IPNormBegin(svd->ip,U[n-1],&a);CHKERRQ(ierr);
1415 slepc 177
  if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
178
    ierr = IPInnerProductBegin(svd->ip,v,v,&dot);CHKERRQ(ierr);
179
  }
1381 slepc 180
  ierr = IPMInnerProductBegin(svd->ip,v,n,V,work);CHKERRQ(ierr);
1352 slepc 181
  ierr = IPNormEnd(svd->ip,U[n-1],&a);CHKERRQ(ierr);
1415 slepc 182
  if (svd->ip->orthog_ref == IP_ORTH_REFINE_IFNEEDED) {
183
    ierr = IPInnerProductEnd(svd->ip,v,v,&dot);CHKERRQ(ierr);
184
  }
1381 slepc 185
  ierr = IPMInnerProductEnd(svd->ip,v,n,V,work);CHKERRQ(ierr);
1328 slepc 186
 
187
  ierr = VecScale(U[n-1],1.0/a);CHKERRQ(ierr);
1755 antodo 188
  for (j=0;j<n;j++) work[j] = work[j] / a;
189
  ierr = SlepcVecMAXPBY(v,1.0/a,-1.0,n,work,V);CHKERRQ(ierr);
1328 slepc 190
 
1415 slepc 191
  switch (svd->ip->orthog_ref) {
192
  case IP_ORTH_REFINE_NEVER:
193
    ierr = IPNorm(svd->ip,v,&b);CHKERRQ(ierr);
194
    break;      
195
  case IP_ORTH_REFINE_ALWAYS:
1755 antodo 196
    ierr = IPOrthogonalizeCGS1(svd->ip,0,PETSC_NULL,n,PETSC_NULL,V,v,work,PETSC_NULL,&b);CHKERRQ(ierr);
1415 slepc 197
    break;
198
  case IP_ORTH_REFINE_IFNEEDED:
199
    onorm = sqrt(PetscRealPart(dot)) / a;
200
    sum = 0.0;
201
    for (j=0;j<i;j++) {
202
      sum += PetscRealPart(work[j] * PetscConj(work[j]));
203
    }
204
    b = PetscRealPart(dot)/(a*a) - sum;
205
    if (b>0.0) b = sqrt(b);
206
    else {
207
      ierr = IPNorm(svd->ip,v,&b);CHKERRQ(ierr);
208
    }
209
    if (b < svd->ip->orthog_eta * onorm) {
1755 antodo 210
      ierr = IPOrthogonalizeCGS1(svd->ip,0,PETSC_NULL,n,PETSC_NULL,V,v,work,PETSC_NULL,&b);CHKERRQ(ierr);
1415 slepc 211
    }
212
    break;
213
  }
214
 
1328 slepc 215
  alpha[n-k-1] = a;
216
  beta[n-k-1] = b;
217
  PetscFunctionReturn(0);
218
}
219
 
220
#undef __FUNCT__  
1298 slepc 221
#define __FUNCT__ "SVDSolve_TRLANCZOS"
222
PetscErrorCode SVDSolve_TRLANCZOS(SVD svd)
223
{
224
  PetscErrorCode ierr;
225
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
1328 slepc 226
  PetscReal      *alpha,*beta,norm;
1341 slepc 227
  PetscScalar    *b,*Q,*PT,*swork;
1605 slepc 228
  PetscInt       i,j,k,l,m,n,nv;
1755 antodo 229
  Vec            v;
1328 slepc 230
  PetscTruth     conv;
1431 slepc 231
  IPOrthogonalizationType orthog;
1298 slepc 232
 
233
  PetscFunctionBegin;
234
  /* allocate working space */
1307 slepc 235
  ierr = PetscMalloc(sizeof(PetscReal)*svd->n,&alpha);CHKERRQ(ierr);
236
  ierr = PetscMalloc(sizeof(PetscReal)*svd->n,&beta);CHKERRQ(ierr);
237
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n,&b);CHKERRQ(ierr);
238
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&Q);CHKERRQ(ierr);
239
  ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&PT);CHKERRQ(ierr);
1605 slepc 240
#if !defined(PETSC_USE_COMPLEX)
241
  if (svd->which == SVD_SMALLEST) {
242
#endif
243
    ierr = PetscMalloc(sizeof(PetscScalar)*svd->n*svd->n,&swork);CHKERRQ(ierr);
244
#if !defined(PETSC_USE_COMPLEX)
245
  } else {
246
    ierr = PetscMalloc(sizeof(PetscScalar)*svd->n,&swork);CHKERRQ(ierr);
247
  }
248
#endif
1328 slepc 249
  ierr = VecDuplicate(svd->V[0],&v);CHKERRQ(ierr);
1431 slepc 250
  ierr = IPGetOrthogonalization(svd->ip,&orthog,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
1298 slepc 251
 
252
  /* normalize start vector */
1328 slepc 253
  ierr = VecCopy(svd->vec_initial,svd->V[0]);CHKERRQ(ierr);
254
  ierr = VecNormalize(svd->V[0],&norm);CHKERRQ(ierr);
1298 slepc 255
 
256
  l = 0;
257
  while (svd->reason == SVD_CONVERGED_ITERATING) {
258
    svd->its++;
259
 
260
    /* inner loop */
1595 slepc 261
    nv = PetscMin(svd->nconv+svd->mpd,svd->n);
1328 slepc 262
    if (lanczos->oneside) {
1940 jroman 263
      if (orthog == IP_ORTH_MGS) {
1755 antodo 264
        ierr = SVDOneSideTRLanczosMGS(svd,alpha,beta,b+svd->nconv,svd->V,v,svd->U,svd->nconv,l,nv,swork);CHKERRQ(ierr);
1431 slepc 265
      } else {
1755 antodo 266
        ierr = SVDOneSideTRLanczosCGS(svd,alpha,beta,b+svd->nconv,svd->V,v,svd->U,svd->nconv,l,nv,swork);CHKERRQ(ierr);
1431 slepc 267
      }
1328 slepc 268
    } else {
1755 antodo 269
      ierr = SVDTwoSideLanczos(svd,alpha,beta,svd->V,v,svd->U,svd->nconv+l,nv,swork);CHKERRQ(ierr);
1298 slepc 270
    }
1595 slepc 271
    ierr = VecScale(v,1.0/beta[nv-svd->nconv-l-1]);CHKERRQ(ierr);
1328 slepc 272
 
1298 slepc 273
    /* compute SVD of general matrix */
1595 slepc 274
    n = nv - svd->nconv;
1298 slepc 275
    /* first l columns */
276
    for (j=0;j<l;j++) {
277
      for (i=0;i<j;i++) Q[j*n+i] = 0.0;    
1328 slepc 278
      Q[j*n+j] = svd->sigma[svd->nconv+j];
1298 slepc 279
      for (i=j+1;i<n;i++) Q[j*n+i] = 0.0;
280
    }
281
    /* l+1 column */
1328 slepc 282
    for (i=0;i<l;i++) Q[l*n+i] = b[i+svd->nconv];
283
    Q[l*n+l] = alpha[0];
1298 slepc 284
    for (i=l+1;i<n;i++) Q[l*n+i] = 0.0;
285
    /* rest of matrix */
286
    for (j=l+1;j<n;j++) {
287
      for (i=0;i<j-1;i++) Q[j*n+i] = 0.0;
1328 slepc 288
      Q[j*n+j-1] = beta[j-l-1];
289
      Q[j*n+j] = alpha[j-l];
1298 slepc 290
      for (i=j+1;i<n;i++) Q[j*n+i] = 0.0;
291
    }
1328 slepc 292
    ierr = SVDDense(n,n,Q,alpha,PETSC_NULL,PT);CHKERRQ(ierr);
1298 slepc 293
 
294
    /* compute error estimates */
1328 slepc 295
    k = 0;
296
    conv = PETSC_TRUE;
1606 slepc 297
    for (i=svd->nconv;i<nv;i++) {
1328 slepc 298
      if (svd->which == SVD_SMALLEST) j = n-i+svd->nconv-1;
299
      else j = i-svd->nconv;
300
      svd->sigma[i] = alpha[j];
301
      b[i] = Q[j*n+n-1]*beta[n-l-1];
302
      svd->errest[i] = PetscAbsScalar(b[i]);
303
      if (alpha[j] > svd->tol) svd->errest[i] /= alpha[j];
304
      if (conv) {
305
        if (svd->errest[i] < svd->tol) k++;
306
        else conv = PETSC_FALSE;
1304 slepc 307
      }
1298 slepc 308
    }
309
 
1328 slepc 310
    /* check convergence and update l */
311
    if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
312
    if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
313
    if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
1606 slepc 314
    else l = PetscMax((nv - svd->nconv - k) / 2,0);
1300 slepc 315
 
1328 slepc 316
    /* compute converged singular vectors and restart vectors*/
1605 slepc 317
#if !defined(PETSC_USE_COMPLEX)
318
    if (svd->which == SVD_SMALLEST) {
319
#endif
1328 slepc 320
    for (i=0;i<k+l;i++) {
321
      if (svd->which == SVD_SMALLEST) j = n-i-1;
322
      else j = i;
1605 slepc 323
      for (m=0;m<n;m++) swork[j*n+m] = PT[m*n+j];
1328 slepc 324
    }
1605 slepc 325
    ierr = SlepcUpdateVectors(n,svd->V+svd->nconv,0,k+l,swork,n,PETSC_FALSE);CHKERRQ(ierr);
326
    for (i=0;i<k+l;i++) {
327
      if (svd->which == SVD_SMALLEST) j = n-i-1;
328
      else j = i;
329
      for (m=0;m<n;m++) swork[j*n+m] = Q[j*n+m];
330
    }
331
    ierr = SlepcUpdateVectors(n,svd->U+svd->nconv,0,k+l,swork,n,PETSC_FALSE);CHKERRQ(ierr);
332
#if !defined(PETSC_USE_COMPLEX)
333
    } else {
334
      ierr = SlepcUpdateVectors(n,svd->V+svd->nconv,0,k+l,PT,n,PETSC_TRUE);CHKERRQ(ierr);
335
      ierr = SlepcUpdateVectors(n,svd->U+svd->nconv,0,k+l,Q,n,PETSC_FALSE);CHKERRQ(ierr);
336
    }
337
#endif
1328 slepc 338
 
1298 slepc 339
    /* copy the last vector to be the next initial vector */
340
    if (svd->reason == SVD_CONVERGED_ITERATING) {
1328 slepc 341
      ierr = VecCopy(v,svd->V[svd->nconv+k+l]);CHKERRQ(ierr);
1298 slepc 342
    }
343
 
1328 slepc 344
    svd->nconv += k;
1595 slepc 345
    SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);
1298 slepc 346
  }
347
 
1603 slepc 348
  /* orthonormalize U columns in one side method */
349
  if (lanczos->oneside) {
350
    for (i=0;i<svd->nconv;i++) {
1755 antodo 351
      ierr = IPOrthogonalize(svd->ip,0,PETSC_NULL,i,PETSC_NULL,svd->U,svd->U[i],PETSC_NULL,&norm,PETSC_NULL);CHKERRQ(ierr);
1489 slepc 352
      ierr = VecScale(svd->U[i],1.0/norm);CHKERRQ(ierr);
353
    }
1298 slepc 354
  }
355
 
356
  /* free working space */
1328 slepc 357
  ierr = VecDestroy(v);CHKERRQ(ierr);
1298 slepc 358
 
359
  ierr = PetscFree(alpha);CHKERRQ(ierr);
360
  ierr = PetscFree(beta);CHKERRQ(ierr);
361
  ierr = PetscFree(b);CHKERRQ(ierr);
362
  ierr = PetscFree(Q);CHKERRQ(ierr);
363
  ierr = PetscFree(PT);CHKERRQ(ierr);
1341 slepc 364
  ierr = PetscFree(swork);CHKERRQ(ierr);
1298 slepc 365
  PetscFunctionReturn(0);
366
}
367
 
368
#undef __FUNCT__  
369
#define __FUNCT__ "SVDSetFromOptions_TRLANCZOS"
370
PetscErrorCode SVDSetFromOptions_TRLANCZOS(SVD svd)
371
{
372
  PetscErrorCode ierr;
1923 jroman 373
  PetscTruth     set,val;
1298 slepc 374
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
375
 
376
  PetscFunctionBegin;
1422 slepc 377
  ierr = PetscOptionsBegin(((PetscObject)svd)->comm,((PetscObject)svd)->prefix,"TRLANCZOS Singular Value Solver Options","SVD");CHKERRQ(ierr);
1923 jroman 378
  ierr = PetscOptionsTruth("-svd_trlanczos_oneside","Lanczos one-side reorthogonalization","SVDTRLanczosSetOneSide",lanczos->oneside,&val,&set);CHKERRQ(ierr);
379
  if (set) {
380
    ierr = SVDTRLanczosSetOneSide(svd,val);CHKERRQ(ierr);
381
  }
1298 slepc 382
  ierr = PetscOptionsEnd();CHKERRQ(ierr);
383
  PetscFunctionReturn(0);
384
}
1370 slepc 385
 
1298 slepc 386
EXTERN_C_BEGIN
387
#undef __FUNCT__  
1359 slepc 388
#define __FUNCT__ "SVDTRLanczosSetOneSide_TRLANCZOS"
389
PetscErrorCode SVDTRLanczosSetOneSide_TRLANCZOS(SVD svd,PetscTruth oneside)
1298 slepc 390
{
391
  SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS *)svd->data;
392
 
393
  PetscFunctionBegin;
394
  lanczos->oneside = oneside;
395
  PetscFunctionReturn(0);
396
}
1370 slepc 397
EXTERN_C_END
1298 slepc 398
 
399
#undef __FUNCT__
1359 slepc 400
#define __FUNCT__ "SVDTRLanczosSetOneSide"
1393 slepc 401
/*@
402
   SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
403
   to be used is one-sided or two-sided.
404
 
405
   Collective on SVD
406
 
407
   Input Parameters:
408
+  svd     - singular value solver
409
-  oneside - boolean flag indicating if the method is one-sided or not
410
 
411
   Options Database Key:
412
.  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag
413
 
414
   Note:
415
   By default, a two-sided variant is selected, which is sometimes slightly
416
   more robust. However, the one-sided variant is faster because it avoids
417
   the orthogonalization associated to left singular vectors.
418
 
419
   Level: advanced
420
 
421
.seealso: SVDLanczosSetOneSide()
422
@*/
1359 slepc 423
PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscTruth oneside)
1298 slepc 424
{
425
  PetscErrorCode ierr, (*f)(SVD,PetscTruth);
426
 
427
  PetscFunctionBegin;
428
  PetscValidHeaderSpecific(svd,SVD_COOKIE,1);
1359 slepc 429
  ierr = PetscObjectQueryFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",(void (**)())&f);CHKERRQ(ierr);
1298 slepc 430
  if (f) {
431
    ierr = (*f)(svd,oneside);CHKERRQ(ierr);
432
  }
433
  PetscFunctionReturn(0);
434
}
435
 
436
#undef __FUNCT__  
1925 jroman 437
#define __FUNCT__ "SVDDestroy_TRLANCZOS"
438
PetscErrorCode SVDDestroy_TRLANCZOS(SVD svd)
439
{
440
  PetscErrorCode ierr;
441
 
442
  PetscFunctionBegin;
443
  PetscValidHeaderSpecific(svd,SVD_COOKIE,1);
444
  ierr = SVDDestroy_Default(svd);CHKERRQ(ierr);
445
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)svd,"SVDTRLanczosSetOneSide_C","",PETSC_NULL);CHKERRQ(ierr);
446
  PetscFunctionReturn(0);
447
}
448
 
449
#undef __FUNCT__  
1298 slepc 450
#define __FUNCT__ "SVDView_TRLANCZOS"
451
PetscErrorCode SVDView_TRLANCZOS(SVD svd,PetscViewer viewer)
452
{
453
  PetscErrorCode ierr;
454
  SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS *)svd->data;
455
 
456
  PetscFunctionBegin;
457
  ierr = PetscViewerASCIIPrintf(viewer,"Lanczos reorthogonalization: %s\n",lanczos->oneside ? "one-side" : "two-side");CHKERRQ(ierr);
458
  PetscFunctionReturn(0);
459
}
460
 
461
EXTERN_C_BEGIN
462
#undef __FUNCT__  
463
#define __FUNCT__ "SVDCreate_TRLANCZOS"
464
PetscErrorCode SVDCreate_TRLANCZOS(SVD svd)
465
{
466
  PetscErrorCode ierr;
467
  SVD_TRLANCZOS  *lanczos;
468
 
469
  PetscFunctionBegin;
470
  ierr = PetscNew(SVD_TRLANCZOS,&lanczos);CHKERRQ(ierr);
471
  PetscLogObjectMemory(svd,sizeof(SVD_TRLANCZOS));
472
  svd->data                = (void *)lanczos;
473
  svd->ops->setup          = SVDSetUp_TRLANCZOS;
474
  svd->ops->solve          = SVDSolve_TRLANCZOS;
1925 jroman 475
  svd->ops->destroy        = SVDDestroy_TRLANCZOS;
1298 slepc 476
  svd->ops->setfromoptions = SVDSetFromOptions_TRLANCZOS;
477
  svd->ops->view           = SVDView_TRLANCZOS;
478
  lanczos->oneside         = PETSC_FALSE;
1359 slepc 479
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)svd,"SVDTRLanczosSetOneSide_C","SVDTRLanczosSetOneSide_TRLANCZOS",SVDTRLanczosSetOneSide_TRLANCZOS);CHKERRQ(ierr);
1298 slepc 480
  PetscFunctionReturn(0);
481
}
482
EXTERN_C_END