Subversion Repositories slepc-dev

Rev

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

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