Subversion Repositories slepc-dev

Rev

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

Rev Author Line No. Line
1324 slepc 1
/*                      
2
 
3
   SLEPc singular value solver: "cross"
4
 
1325 slepc 5
   Method: Uses a Hermitian eigensolver for A^T*A
1324 slepc 6
 
1397 slepc 7
   Last update: Jun 2007
1324 slepc 8
 
1376 slepc 9
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
10
      SLEPc - Scalable Library for Eigenvalue Problem Computations
11
      Copyright (c) 2002-2007, Universidad Politecnica de Valencia, Spain
12
 
13
      This file is part of SLEPc. See the README file for conditions of use
14
      and additional information.
15
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1324 slepc 16
*/
1376 slepc 17
 
1324 slepc 18
#include "src/svd/svdimpl.h"                /*I "slepcsvd.h" I*/
19
#include "slepceps.h"
20
 
21
typedef struct {
22
  EPS eps;
23
  Mat mat;
24
  Vec w,diag;
25
} SVD_CROSS;
26
 
27
#undef __FUNCT__  
28
#define __FUNCT__ "ShellMatMult_CROSS"
29
PetscErrorCode ShellMatMult_CROSS(Mat B,Vec x, Vec y)
30
{
31
  PetscErrorCode ierr;
32
  SVD            svd;
33
  SVD_CROSS      *cross;
34
 
35
  PetscFunctionBegin;
36
  ierr = MatShellGetContext(B,(void**)&svd);CHKERRQ(ierr);
37
  cross = (SVD_CROSS *)svd->data;
38
  ierr = SVDMatMult(svd,PETSC_FALSE,x,cross->w);CHKERRQ(ierr);
39
  ierr = SVDMatMult(svd,PETSC_TRUE,cross->w,y);CHKERRQ(ierr);
40
  PetscFunctionReturn(0);
41
}
42
 
43
#undef __FUNCT__  
44
#define __FUNCT__ "ShellMatGetDiagonal_CROSS"
45
PetscErrorCode ShellMatGetDiagonal_CROSS(Mat B,Vec d)
46
{
47
  PetscErrorCode    ierr;
48
  SVD               svd;
49
  SVD_CROSS         *cross;
50
  PetscInt          N,n,i,j,start,end,ncols;
51
  PetscScalar       *work1,*work2,*diag;
52
  const PetscInt    *cols;
53
  const PetscScalar *vals;
54
 
55
  PetscFunctionBegin;
56
  ierr = MatShellGetContext(B,(void**)&svd);CHKERRQ(ierr);
57
  cross = (SVD_CROSS *)svd->data;
58
  if (!cross->diag) {
59
    /* compute diagonal from rows and store in cross->diag */
60
    ierr = VecDuplicate(d,&cross->diag);CHKERRQ(ierr);
61
    ierr = SVDMatGetSize(svd,PETSC_NULL,&N);CHKERRQ(ierr);
62
    ierr = SVDMatGetLocalSize(svd,PETSC_NULL,&n);CHKERRQ(ierr);
63
    ierr = PetscMalloc(sizeof(PetscScalar)*N,&work1);CHKERRQ(ierr);
64
    ierr = PetscMalloc(sizeof(PetscScalar)*N,&work2);CHKERRQ(ierr);
65
    for (i=0;i<n;i++) work1[i] = work2[i] = 0.0;
66
    if (svd->AT) {
67
      ierr = MatGetOwnershipRange(svd->AT,&start,&end);CHKERRQ(ierr);
68
      for (i=start;i<end;i++) {
69
        ierr = MatGetRow(svd->AT,i,&ncols,PETSC_NULL,&vals);CHKERRQ(ierr);
70
        for (j=0;j<ncols;j++)
71
          work1[i] += vals[j]*vals[j];
72
        ierr = MatRestoreRow(svd->AT,i,&ncols,PETSC_NULL,&vals);CHKERRQ(ierr);
73
      }
74
    } else {
75
      ierr = MatGetOwnershipRange(svd->A,&start,&end);CHKERRQ(ierr);
76
      for (i=start;i<end;i++) {
77
        ierr = MatGetRow(svd->A,i,&ncols,&cols,&vals);CHKERRQ(ierr);
78
        for (j=0;j<ncols;j++)
79
          work1[cols[j]] += vals[j]*vals[j];
80
        ierr = MatRestoreRow(svd->A,i,&ncols,&cols,&vals);CHKERRQ(ierr);
81
      }
82
    }
83
    ierr = MPI_Allreduce(work1,work2,N,MPIU_SCALAR,MPI_SUM,svd->comm);CHKERRQ(ierr);
84
    ierr = VecGetOwnershipRange(cross->diag,&start,&end);CHKERRQ(ierr);
85
    ierr = VecGetArray(cross->diag,&diag);CHKERRQ(ierr);
86
    for (i=start;i<end;i++)
87
      diag[i-start] = work2[i];
88
    ierr = VecRestoreArray(cross->diag,&diag);CHKERRQ(ierr);
89
    ierr = PetscFree(work1);CHKERRQ(ierr);
90
    ierr = PetscFree(work2);CHKERRQ(ierr);
91
  }
92
  ierr = VecCopy(cross->diag,d);CHKERRQ(ierr);
93
  PetscFunctionReturn(0);
94
}
95
 
96
#undef __FUNCT__  
97
#define __FUNCT__ "SVDSetUp_CROSS"
98
PetscErrorCode SVDSetUp_CROSS(SVD svd)
99
{
100
  PetscErrorCode    ierr;
101
  SVD_CROSS         *cross = (SVD_CROSS *)svd->data;
102
  PetscInt          n;
103
 
104
  PetscFunctionBegin;
105
  if (cross->mat) {
106
     ierr = MatDestroy(cross->mat);CHKERRQ(ierr);
107
     ierr = VecDestroy(cross->w);CHKERRQ(ierr);
108
  }
109
  if (cross->diag) {
110
     ierr = VecDestroy(cross->diag);CHKERRQ(ierr);
111
  }
112
 
113
  ierr = SVDMatGetLocalSize(svd,PETSC_NULL,&n);CHKERRQ(ierr);
114
  ierr = MatCreateShell(svd->comm,n,n,PETSC_DETERMINE,PETSC_DETERMINE,svd,&cross->mat);CHKERRQ(ierr);
115
  ierr = MatShellSetOperation(cross->mat,MATOP_MULT,(void(*)(void))ShellMatMult_CROSS);CHKERRQ(ierr);  
116
  ierr = MatShellSetOperation(cross->mat,MATOP_GET_DIAGONAL,(void(*)(void))ShellMatGetDiagonal_CROSS);CHKERRQ(ierr);  
117
  ierr = SVDMatGetVecs(svd,PETSC_NULL,&cross->w);CHKERRQ(ierr);
118
 
119
  ierr = EPSSetOperators(cross->eps,cross->mat,PETSC_NULL);CHKERRQ(ierr);
120
  ierr = EPSSetProblemType(cross->eps,EPS_HEP);CHKERRQ(ierr);
121
  ierr = EPSSetDimensions(cross->eps,svd->nsv,svd->ncv);CHKERRQ(ierr);
122
  ierr = EPSSetTolerances(cross->eps,svd->tol,svd->max_it);CHKERRQ(ierr);
123
  ierr = EPSSetUp(cross->eps);CHKERRQ(ierr);
124
  ierr = EPSGetDimensions(cross->eps,PETSC_NULL,&svd->ncv);CHKERRQ(ierr);
125
  ierr = EPSGetTolerances(cross->eps,&svd->tol,&svd->max_it);CHKERRQ(ierr);
126
  PetscFunctionReturn(0);
127
}
128
 
129
#undef __FUNCT__  
130
#define __FUNCT__ "SVDSolve_CROSS"
131
PetscErrorCode SVDSolve_CROSS(SVD svd)
132
{
133
  PetscErrorCode ierr;
134
  SVD_CROSS      *cross = (SVD_CROSS *)svd->data;
135
  int            i;
136
  PetscScalar    sigma;
137
 
138
  PetscFunctionBegin;
1374 slepc 139
  ierr = EPSSetWhichEigenpairs(cross->eps,svd->which == SVD_LARGEST ? EPS_LARGEST_REAL : EPS_SMALLEST_REAL);CHKERRQ(ierr);
1324 slepc 140
  ierr = EPSSetInitialVector(cross->eps,svd->vec_initial);CHKERRQ(ierr);
141
  ierr = EPSSolve(cross->eps);CHKERRQ(ierr);
142
  ierr = EPSGetConverged(cross->eps,&svd->nconv);CHKERRQ(ierr);
143
  ierr = EPSGetIterationNumber(cross->eps,&svd->its);CHKERRQ(ierr);
144
  ierr = EPSGetConvergedReason(cross->eps,(EPSConvergedReason*)&svd->reason);CHKERRQ(ierr);
145
  for (i=0;i<svd->nconv;i++) {
146
    ierr = EPSGetEigenpair(cross->eps,i,&sigma,PETSC_NULL,svd->V[i],PETSC_NULL);CHKERRQ(ierr);
147
    svd->sigma[i] = sqrt(PetscRealPart(sigma));
148
  }
149
  PetscFunctionReturn(0);
150
}
151
 
152
#undef __FUNCT__  
153
#define __FUNCT__ "SVDMonitor_CROSS"
154
PetscErrorCode SVDMonitor_CROSS(EPS eps,int its,int nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int nest,void *ctx)
155
{
156
  int       i;
157
  SVD       svd = (SVD)ctx;
158
 
159
  PetscFunctionBegin;
160
  for (i=0;i<nest;i++) {
161
    svd->sigma[i] = sqrt(PetscRealPart(eigr[i]));
162
    svd->errest[i] = errest[i];
163
  }
164
  SVDMonitor(svd,its,nconv,svd->sigma,svd->errest,nest);
165
  PetscFunctionReturn(0);
166
}
167
 
168
#undef __FUNCT__  
169
#define __FUNCT__ "SVDSetFromOptions_CROSS"
170
PetscErrorCode SVDSetFromOptions_CROSS(SVD svd)
171
{
172
  PetscErrorCode ierr;
173
  SVD_CROSS      *cross = (SVD_CROSS *)svd->data;
174
 
175
  PetscFunctionBegin;
176
  ierr = EPSSetFromOptions(cross->eps);CHKERRQ(ierr);
177
  PetscFunctionReturn(0);
178
}
179
 
180
EXTERN_C_BEGIN
181
#undef __FUNCT__  
182
#define __FUNCT__ "SVDCrossSetEPS_CROSS"
183
PetscErrorCode SVDCrossSetEPS_CROSS(SVD svd,EPS eps)
184
{
185
  PetscErrorCode ierr;
186
  SVD_CROSS      *cross = (SVD_CROSS *)svd->data;
187
 
188
  PetscFunctionBegin;
189
  PetscValidHeaderSpecific(eps,EPS_COOKIE,2);
190
  PetscCheckSameComm(svd,1,eps,2);
191
  ierr = PetscObjectReference((PetscObject)eps);CHKERRQ(ierr);
192
  ierr = EPSDestroy(cross->eps);CHKERRQ(ierr);  
193
  cross->eps = eps;
194
  svd->setupcalled = 0;
195
  PetscFunctionReturn(0);
196
}
197
EXTERN_C_END
198
 
199
#undef __FUNCT__  
200
#define __FUNCT__ "SVDCrossSetEPS"
201
/*@
1325 slepc 202
   SVDCrossSetEPS - Associate an eigensolver object (EPS) to the
1324 slepc 203
   singular value solver.
204
 
205
   Collective on SVD
206
 
207
   Input Parameters:
208
+  svd - singular value solver
209
-  eps - the eigensolver object
210
 
211
   Level: advanced
212
 
213
.seealso: SVDCrossGetEPS()
214
@*/
215
PetscErrorCode SVDCrossSetEPS(SVD svd,EPS eps)
216
{
217
  PetscErrorCode ierr, (*f)(SVD,EPS eps);
218
 
219
  PetscFunctionBegin;
220
  PetscValidHeaderSpecific(svd,SVD_COOKIE,1);
221
  ierr = PetscObjectQueryFunction((PetscObject)svd,"SVDCrossSetEPS_C",(void (**)())&f);CHKERRQ(ierr);
222
  if (f) {
223
    ierr = (*f)(svd,eps);CHKERRQ(ierr);
224
  }
225
  PetscFunctionReturn(0);
226
}
227
 
228
EXTERN_C_BEGIN
229
#undef __FUNCT__  
230
#define __FUNCT__ "SVDCrossGetEPS_CROSS"
231
PetscErrorCode SVDCrossGetEPS_CROSS(SVD svd,EPS *eps)
232
{
233
  SVD_CROSS *cross = (SVD_CROSS *)svd->data;
234
 
235
  PetscFunctionBegin;
236
  PetscValidPointer(eps,2);
237
  *eps = cross->eps;
238
  PetscFunctionReturn(0);
239
}
240
EXTERN_C_END
241
 
242
#undef __FUNCT__  
243
#define __FUNCT__ "SVDCrossGetEPS"
244
/*@C
245
   SVDCrossGetEPS - Retrieve the eigensolver object (EPS) associated
246
   to the singular value solver.
247
 
248
   Not Collective
249
 
1325 slepc 250
   Input Parameter:
1324 slepc 251
.  svd - singular value solver
252
 
253
   Output Parameter:
254
.  eps - the eigensolver object
255
 
256
   Level: advanced
257
 
258
.seealso: SVDCrossSetEPS()
259
@*/
260
PetscErrorCode SVDCrossGetEPS(SVD svd,EPS *eps)
261
{
262
  PetscErrorCode ierr, (*f)(SVD,EPS *eps);
263
 
264
  PetscFunctionBegin;
265
  PetscValidHeaderSpecific(svd,SVD_COOKIE,1);
266
  ierr = PetscObjectQueryFunction((PetscObject)svd,"SVDCrossGetEPS_C",(void (**)())&f);CHKERRQ(ierr);
267
  if (f) {
268
    ierr = (*f)(svd,eps);CHKERRQ(ierr);
269
  }
270
  PetscFunctionReturn(0);
271
}
272
 
273
#undef __FUNCT__  
274
#define __FUNCT__ "SVDView_CROSS"
275
PetscErrorCode SVDView_CROSS(SVD svd,PetscViewer viewer)
276
{
277
  PetscErrorCode ierr;
278
  SVD_CROSS      *cross = (SVD_CROSS *)svd->data;
279
 
280
  PetscFunctionBegin;
281
  ierr = EPSView(cross->eps,viewer);CHKERRQ(ierr);
282
  PetscFunctionReturn(0);
283
}
284
 
285
#undef __FUNCT__  
286
#define __FUNCT__ "SVDDestroy_CROSS"
287
PetscErrorCode SVDDestroy_CROSS(SVD svd)
288
{
289
  PetscErrorCode ierr;
290
  SVD_CROSS      *cross = (SVD_CROSS *)svd->data;
291
 
292
  PetscFunctionBegin;
293
  ierr = EPSDestroy(cross->eps);CHKERRQ(ierr);
294
  if (cross->mat) {
295
    ierr = MatDestroy(cross->mat);CHKERRQ(ierr);
296
    ierr = VecDestroy(cross->w);CHKERRQ(ierr);
297
  }
298
  if (cross->diag) {
299
    ierr = VecDestroy(cross->diag);CHKERRQ(ierr);
300
  }
1396 slepc 301
  ierr = PetscFree(svd->data);CHKERRQ(ierr);
1324 slepc 302
  PetscFunctionReturn(0);
303
}
304
 
305
EXTERN_C_BEGIN
306
#undef __FUNCT__  
307
#define __FUNCT__ "SVDCreate_CROSS"
308
PetscErrorCode SVDCreate_CROSS(SVD svd)
309
{
310
  PetscErrorCode ierr;
311
  SVD_CROSS      *cross;
312
  ST             st;
313
 
314
  PetscFunctionBegin;
315
  ierr = PetscNew(SVD_CROSS,&cross);CHKERRQ(ierr);
316
  PetscLogObjectMemory(svd,sizeof(SVD_CROSS));
317
  svd->data                = (void *)cross;
318
  svd->ops->solve          = SVDSolve_CROSS;
319
  svd->ops->setup          = SVDSetUp_CROSS;
320
  svd->ops->setfromoptions = SVDSetFromOptions_CROSS;
321
  svd->ops->destroy        = SVDDestroy_CROSS;
322
  svd->ops->view           = SVDView_CROSS;
323
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)svd,"SVDCrossSetEPS_C","SVDCrossSetEPS_CROSS",SVDCrossSetEPS_CROSS);CHKERRQ(ierr);
324
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)svd,"SVDCrossGetEPS_C","SVDCrossGetEPS_CROSS",SVDCrossGetEPS_CROSS);CHKERRQ(ierr);
325
 
326
  ierr = EPSCreate(svd->comm,&cross->eps);CHKERRQ(ierr);
327
  ierr = EPSSetOptionsPrefix(cross->eps,svd->prefix);CHKERRQ(ierr);
328
  ierr = EPSAppendOptionsPrefix(cross->eps,"svd_");CHKERRQ(ierr);
329
  PetscLogObjectParent(svd,cross->eps);
1345 slepc 330
  ierr = EPSSetIP(cross->eps,svd->ip);CHKERRQ(ierr);
1324 slepc 331
  ierr = EPSSetWhichEigenpairs(cross->eps,EPS_LARGEST_REAL);CHKERRQ(ierr);
1331 slepc 332
  ierr = EPSMonitorSet(cross->eps,SVDMonitor_CROSS,svd,PETSC_NULL);CHKERRQ(ierr);
1324 slepc 333
  ierr = EPSGetST(cross->eps,&st);CHKERRQ(ierr);
334
  ierr = STSetMatMode(st,STMATMODE_SHELL);CHKERRQ(ierr);
335
  cross->mat = PETSC_NULL;
336
  cross->w = PETSC_NULL;
337
  cross->diag = PETSC_NULL;
338
  PetscFunctionReturn(0);
339
}
340
EXTERN_C_END