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
1302 slepc 1
/*
2
     Basic routines
1376 slepc 3
 
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
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1302 slepc 22
*/
1376 slepc 23
 
2283 jroman 24
#include <private/ipimpl.h>      /*I "slepcip.h" I*/
1302 slepc 25
 
2373 jroman 26
PetscFList       IPList = 0;
27
PetscClassId     IP_CLASSID = 0;
28
PetscLogEvent    IP_InnerProduct = 0,IP_Orthogonalize = 0,IP_ApplyMatrix = 0;
29
static PetscBool IPPackageInitialized = PETSC_FALSE;
1302 slepc 30
 
31
#undef __FUNCT__  
2373 jroman 32
#define __FUNCT__ "IPFinalizePackage"
33
/*@C
34
   IPFinalizePackage - This function destroys everything in the Slepc interface
35
   to the IP package. It is called from SlepcFinalize().
36
 
37
   Level: developer
38
 
39
.seealso: SlepcFinalize()
40
@*/
41
PetscErrorCode IPFinalizePackage(void)
42
{
43
  PetscFunctionBegin;
44
  IPPackageInitialized = PETSC_FALSE;
45
  IPList               = 0;
46
  PetscFunctionReturn(0);
47
}
48
 
49
#undef __FUNCT__  
1329 slepc 50
#define __FUNCT__ "IPInitializePackage"
1345 slepc 51
/*@C
52
  IPInitializePackage - This function initializes everything in the IP package. It is called
53
  from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to IPCreate()
54
  when using static libraries.
55
 
56
  Input Parameter:
57
  path - The dynamic library path, or PETSC_NULL
58
 
59
  Level: developer
60
 
61
.seealso: SlepcInitialize()
62
@*/
2212 jroman 63
PetscErrorCode IPInitializePackage(const char *path)
1302 slepc 64
{
2317 jroman 65
  char             logList[256];
66
  char             *className;
67
  PetscBool        opt;
68
  PetscErrorCode   ierr;
1302 slepc 69
 
70
  PetscFunctionBegin;
2373 jroman 71
  if (IPPackageInitialized) PetscFunctionReturn(0);
72
  IPPackageInitialized = PETSC_TRUE;
1302 slepc 73
  /* Register Classes */
2213 jroman 74
  ierr = PetscClassIdRegister("Inner product",&IP_CLASSID);CHKERRQ(ierr);
2373 jroman 75
  /* Register Constructors */
76
  ierr = IPRegisterAll(path);CHKERRQ(ierr);
1302 slepc 77
  /* Register Events */
2330 jroman 78
  ierr = PetscLogEventRegister("IPOrthogonalize",IP_CLASSID,&IP_Orthogonalize);CHKERRQ(ierr);
79
  ierr = PetscLogEventRegister("IPInnerProduct",IP_CLASSID,&IP_InnerProduct);CHKERRQ(ierr);
80
  ierr = PetscLogEventRegister("IPApplyMatrix",IP_CLASSID,&IP_ApplyMatrix);CHKERRQ(ierr);
1302 slepc 81
  /* Process info exclusions */
2331 jroman 82
  ierr = PetscOptionsGetString(PETSC_NULL,"-info_exclude",logList,256,&opt);CHKERRQ(ierr);
1302 slepc 83
  if (opt) {
2331 jroman 84
    ierr = PetscStrstr(logList,"ip",&className);CHKERRQ(ierr);
1302 slepc 85
    if (className) {
2213 jroman 86
      ierr = PetscInfoDeactivateClass(IP_CLASSID);CHKERRQ(ierr);
1302 slepc 87
    }
88
  }
89
  /* Process summary exclusions */
2331 jroman 90
  ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary_exclude",logList,256,&opt);CHKERRQ(ierr);
1302 slepc 91
  if (opt) {
2331 jroman 92
    ierr = PetscStrstr(logList,"ip",&className);CHKERRQ(ierr);
1302 slepc 93
    if (className) {
2213 jroman 94
      ierr = PetscLogEventDeactivateClass(IP_CLASSID);CHKERRQ(ierr);
1302 slepc 95
    }
96
  }
2373 jroman 97
  ierr = PetscRegisterFinalize(IPFinalizePackage);CHKERRQ(ierr);
1302 slepc 98
  PetscFunctionReturn(0);
99
}
100
 
101
#undef __FUNCT__  
102
#define __FUNCT__ "IPCreate"
1345 slepc 103
/*@C
104
   IPCreate - Creates an IP context.
105
 
106
   Collective on MPI_Comm
107
 
108
   Input Parameter:
109
.  comm - MPI communicator
110
 
111
   Output Parameter:
1349 slepc 112
.  newip - location to put the IP context
1345 slepc 113
 
114
   Level: beginner
115
 
1349 slepc 116
   Note:
117
   IP objects are not intended for normal users but only for
118
   advanced user that for instance implement their own solvers.
119
 
1345 slepc 120
.seealso: IPDestroy(), IP
121
@*/
1302 slepc 122
PetscErrorCode IPCreate(MPI_Comm comm,IP *newip)
123
{
2317 jroman 124
  IP             ip;
1345 slepc 125
  PetscErrorCode ierr;
1302 slepc 126
 
127
  PetscFunctionBegin;
128
  PetscValidPointer(newip,2);
2373 jroman 129
  ierr = PetscHeaderCreate(ip,_p_IP,struct _IPOps,IP_CLASSID,-1,"IP",comm,IPDestroy,IPView);CHKERRQ(ierr);
1302 slepc 130
  *newip            = ip;
2370 jroman 131
  ip->orthog_type   = IP_ORTHOG_CGS;
132
  ip->orthog_ref    = IP_ORTHOG_REFINE_IFNEEDED;
1302 slepc 133
  ip->orthog_eta    = 0.7071;
1940 jroman 134
  ip->bilinear_form = IP_INNER_HERMITIAN;
1302 slepc 135
  ip->innerproducts = 0;
1329 slepc 136
  ip->matrix        = PETSC_NULL;
1361 slepc 137
  ip->Bx            = PETSC_NULL;
138
  ip->xid           = 0;
139
  ip->xstate        = 0;
1302 slepc 140
  PetscFunctionReturn(0);
141
}
142
 
143
#undef __FUNCT__  
1316 slepc 144
#define __FUNCT__ "IPSetOptionsPrefix"
1345 slepc 145
/*@C
146
   IPSetOptionsPrefix - Sets the prefix used for searching for all
147
   IP options in the database.
148
 
2328 jroman 149
   Logically Collective on IP
1345 slepc 150
 
151
   Input Parameters:
152
+  ip - the innerproduct context
153
-  prefix - the prefix string to prepend to all IP option requests
154
 
155
   Notes:
156
   A hyphen (-) must NOT be given at the beginning of the prefix name.
157
   The first character of all runtime options is AUTOMATICALLY the
158
   hyphen.
159
 
160
   Level: advanced
161
 
162
.seealso: IPAppendOptionsPrefix()
163
@*/
1316 slepc 164
PetscErrorCode IPSetOptionsPrefix(IP ip,const char *prefix)
165
{
166
  PetscErrorCode ierr;
2317 jroman 167
 
1316 slepc 168
  PetscFunctionBegin;
2213 jroman 169
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
1316 slepc 170
  ierr = PetscObjectSetOptionsPrefix((PetscObject)ip,prefix);CHKERRQ(ierr);
171
  PetscFunctionReturn(0);
172
}
173
 
174
#undef __FUNCT__  
1302 slepc 175
#define __FUNCT__ "IPAppendOptionsPrefix"
1345 slepc 176
/*@C
177
   IPAppendOptionsPrefix - Appends to the prefix used for searching for all
178
   IP options in the database.
179
 
2328 jroman 180
   Logically Collective on IP
1345 slepc 181
 
182
   Input Parameters:
183
+  ip - the innerproduct context
184
-  prefix - the prefix string to prepend to all IP option requests
185
 
186
   Notes:
187
   A hyphen (-) must NOT be given at the beginning of the prefix name.
188
   The first character of all runtime options is AUTOMATICALLY the hyphen.
189
 
190
   Level: advanced
191
 
192
.seealso: IPSetOptionsPrefix()
193
@*/
1302 slepc 194
PetscErrorCode IPAppendOptionsPrefix(IP ip,const char *prefix)
195
{
196
  PetscErrorCode ierr;
2317 jroman 197
 
1302 slepc 198
  PetscFunctionBegin;
2213 jroman 199
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
1302 slepc 200
  ierr = PetscObjectAppendOptionsPrefix((PetscObject)ip,prefix);CHKERRQ(ierr);
201
  PetscFunctionReturn(0);
202
}
203
 
1518 slepc 204
#undef __FUNCT__
205
#define __FUNCT__ "IPGetOptionsPrefix"
206
/*@C
207
   IPGetOptionsPrefix - Gets the prefix used for searching for all
208
   IP options in the database.
209
 
210
   Not Collective
211
 
212
   Input Parameters:
213
.  ip - the innerproduct context
214
 
215
   Output Parameters:
216
.  prefix - pointer to the prefix string used is returned
217
 
218
   Notes: On the fortran side, the user should pass in a string 'prefix' of
219
   sufficient length to hold the prefix.
220
 
221
   Level: advanced
222
 
223
.seealso: IPSetOptionsPrefix(), IPAppendOptionsPrefix()
224
@*/
225
PetscErrorCode IPGetOptionsPrefix(IP ip,const char *prefix[])
226
{
2317 jroman 227
  PetscErrorCode ierr;
228
 
229
  PetscFunctionBegin;
230
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
231
  PetscValidPointer(prefix,2);
2331 jroman 232
  ierr = PetscObjectGetOptionsPrefix((PetscObject)ip,prefix);CHKERRQ(ierr);
2317 jroman 233
  PetscFunctionReturn(0);
1518 slepc 234
}
235
 
1302 slepc 236
#undef __FUNCT__  
2373 jroman 237
#define __FUNCT__ "IPSetType"
238
/*@C
239
   IPSetType - Selects the type for the IP object.
240
 
241
   Logically Collective on IP
242
 
243
   Input Parameter:
244
+  ip   - the inner product context.
245
-  type - a known type
246
 
247
   Notes:
248
   Two types are available: IPBILINEAR and IPSESQUILINEAR.
249
 
250
   For complex scalars, the default is a sesquilinear form (x,y)=x^H*M*y and it is
251
   also possible to choose a bilinear form (x,y)=x^T*M*y (without complex conjugation).
252
   The latter could be useful e.g. in complex-symmetric eigensolvers.
253
 
254
   In the case of real scalars, only the bilinear form (x,y)=x^T*M*y is available.
255
 
256
   Level: advanced
257
 
258
.seealso: IPGetType()
259
 
260
@*/
261
PetscErrorCode IPSetType(IP ip,const IPType type)
262
{
263
  PetscErrorCode ierr,(*r)(IP);
264
  PetscBool      match;
265
 
266
  PetscFunctionBegin;
267
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
268
  PetscValidCharPointer(type,2);
269
 
270
  ierr = PetscTypeCompare((PetscObject)ip,type,&match);CHKERRQ(ierr);
271
  if (match) PetscFunctionReturn(0);
272
 
273
  ierr =  PetscFListFind(IPList,((PetscObject)ip)->comm,type,PETSC_TRUE,(void (**)(void))&r);CHKERRQ(ierr);
274
  if (!r) SETERRQ1(((PetscObject)ip)->comm,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested IP type %s",type);
275
 
276
  ierr = PetscMemzero(ip->ops,sizeof(struct _IPOps));CHKERRQ(ierr);
277
 
278
  ierr = PetscObjectChangeTypeName((PetscObject)ip,type);CHKERRQ(ierr);
279
  ierr = (*r)(ip);CHKERRQ(ierr);
280
  PetscFunctionReturn(0);
281
}
282
 
283
#undef __FUNCT__  
284
#define __FUNCT__ "IPGetType"
285
/*@C
286
   IPGetType - Gets the IP type name (as a string) from the IP context.
287
 
288
   Not Collective
289
 
290
   Input Parameter:
291
.  ip - the inner product context
292
 
293
   Output Parameter:
294
.  name - name of the inner product
295
 
296
   Level: advanced
297
 
298
.seealso: IPSetType()
299
 
300
@*/
301
PetscErrorCode IPGetType(IP ip,const IPType *type)
302
{
303
  PetscFunctionBegin;
304
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
305
  PetscValidPointer(type,2);
306
  *type = ((PetscObject)ip)->type_name;
307
  PetscFunctionReturn(0);
308
}
309
 
310
#undef __FUNCT__  
1302 slepc 311
#define __FUNCT__ "IPSetFromOptions"
1345 slepc 312
/*@
313
   IPSetFromOptions - Sets IP options from the options database.
314
 
315
   Collective on IP
316
 
317
   Input Parameters:
318
.  ip - the innerproduct context
319
 
320
   Notes:  
321
   To see all options, run your program with the -help option.
322
 
323
   Level: beginner
324
@*/
1302 slepc 325
PetscErrorCode IPSetFromOptions(IP ip)
326
{
2331 jroman 327
  const char     *orth_list[2] = {"mgs","cgs"};
328
  const char     *ref_list[3] = {"never","ifneeded","always"};
1302 slepc 329
  PetscReal      r;
330
  PetscInt       i,j;
2317 jroman 331
  PetscErrorCode ierr;
1302 slepc 332
 
333
  PetscFunctionBegin;
2213 jroman 334
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
2373 jroman 335
  if (!((PetscObject)ip)->type_name) {
336
    /* Set default type (we do not allow changing it with -ip_type) */
337
#if defined(PETSC_USE_COMPLEX)
338
    ierr = IPSetType(ip,IPSESQUILINEAR);CHKERRQ(ierr);
339
#else
340
    ierr = IPSetType(ip,IPBILINEAR);CHKERRQ(ierr);
341
#endif
342
  }
1422 slepc 343
  ierr = PetscOptionsBegin(((PetscObject)ip)->comm,((PetscObject)ip)->prefix,"Inner Product (IP) Options","IP");CHKERRQ(ierr);
2373 jroman 344
    i = ip->orthog_type;
345
    ierr = PetscOptionsEList("-ip_orthog_type","Orthogonalization method","IPSetOrthogonalization",orth_list,2,orth_list[i],&i,PETSC_NULL);CHKERRQ(ierr);
346
    j = ip->orthog_ref;
347
    ierr = PetscOptionsEList("-ip_orthog_refine","Iterative refinement mode during orthogonalization","IPSetOrthogonalization",ref_list,3,ref_list[j],&j,PETSC_NULL);CHKERRQ(ierr);
348
    r = ip->orthog_eta;
349
    ierr = PetscOptionsReal("-ip_orthog_eta","Parameter of iterative refinement during orthogonalization","IPSetOrthogonalization",r,&r,PETSC_NULL);CHKERRQ(ierr);
350
    ierr = IPSetOrthogonalization(ip,(IPOrthogType)i,(IPOrthogRefineType)j,r);CHKERRQ(ierr);
1302 slepc 351
  ierr = PetscOptionsEnd();CHKERRQ(ierr);
352
  PetscFunctionReturn(0);
353
}
354
 
355
#undef __FUNCT__  
356
#define __FUNCT__ "IPSetOrthogonalization"
1345 slepc 357
/*@
358
   IPSetOrthogonalization - Specifies the type of orthogonalization technique
359
   to be used (classical or modified Gram-Schmidt with or without refinement).
360
 
2328 jroman 361
   Logically Collective on IP
1345 slepc 362
 
363
   Input Parameters:
2370 jroman 364
+  ip     - the innerproduct context
365
.  type   - the type of orthogonalization technique
366
.  refine - type of refinement
367
-  eta    - parameter for selective refinement
1345 slepc 368
 
369
   Options Database Keys:
2370 jroman 370
+  -orthog_type <type> - Where <type> is cgs for Classical Gram-Schmidt orthogonalization
371
                         (default) or mgs for Modified Gram-Schmidt orthogonalization
372
.  -orthog_refine <type> - Where <type> is one of never, ifneeded (default) or always
1345 slepc 373
-  -orthog_eta <eta> -  For setting the value of eta
374
 
375
   Notes:  
376
   The default settings work well for most problems.
377
 
378
   The parameter eta should be a real value between 0 and 1 (or PETSC_DEFAULT).
379
   The value of eta is used only when the refinement type is "ifneeded".
380
 
381
   When using several processors, MGS is likely to result in bad scalability.
382
 
383
   Level: advanced
384
 
2370 jroman 385
.seealso: IPOrthogonalize(), IPGetOrthogonalization(), IPOrthogType,
386
          IPOrthogRefineType
1345 slepc 387
@*/
2370 jroman 388
PetscErrorCode IPSetOrthogonalization(IP ip,IPOrthogType type,IPOrthogRefineType refine,PetscReal eta)
1302 slepc 389
{
390
  PetscFunctionBegin;
2213 jroman 391
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
2326 jroman 392
  PetscValidLogicalCollectiveEnum(ip,type,2);
2370 jroman 393
  PetscValidLogicalCollectiveEnum(ip,refine,3);
2326 jroman 394
  PetscValidLogicalCollectiveReal(ip,eta,4);
1302 slepc 395
  switch (type) {
2370 jroman 396
    case IP_ORTHOG_CGS:
397
    case IP_ORTHOG_MGS:
1302 slepc 398
      ip->orthog_type = type;
399
      break;
400
    default:
2214 jroman 401
      SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type");
1302 slepc 402
  }
2370 jroman 403
  switch (refine) {
404
    case IP_ORTHOG_REFINE_NEVER:
405
    case IP_ORTHOG_REFINE_IFNEEDED:
406
    case IP_ORTHOG_REFINE_ALWAYS:
407
      ip->orthog_ref = refine;
1302 slepc 408
      break;
409
    default:
2214 jroman 410
      SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_WRONG,"Unknown refinement type");
1302 slepc 411
  }
412
  if (eta == PETSC_DEFAULT) {
413
    ip->orthog_eta = 0.7071;
414
  } else {
2214 jroman 415
    if (eta <= 0.0 || eta > 1.0) SETERRQ(((PetscObject)ip)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid eta value");    
1302 slepc 416
    ip->orthog_eta = eta;
417
  }
418
  PetscFunctionReturn(0);
419
}
420
 
421
#undef __FUNCT__  
1345 slepc 422
#define __FUNCT__ "IPGetOrthogonalization"
423
/*@C
424
   IPGetOrthogonalization - Gets the orthogonalization settings from the
425
   IP object.
426
 
427
   Not Collective
428
 
429
   Input Parameter:
430
.  ip - inner product context
431
 
432
   Output Parameter:
2370 jroman 433
+  type   - type of orthogonalization technique
434
.  refine - type of refinement
435
-  eta    - parameter for selective refinement
1345 slepc 436
 
437
   Level: advanced
438
 
2370 jroman 439
.seealso: IPOrthogonalize(), IPSetOrthogonalization(), IPOrthogType,
440
          IPOrthogRefineType
1345 slepc 441
@*/
2370 jroman 442
PetscErrorCode IPGetOrthogonalization(IP ip,IPOrthogType *type,IPOrthogRefineType *refine,PetscReal *eta)
1345 slepc 443
{
444
  PetscFunctionBegin;
2213 jroman 445
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
2370 jroman 446
  if (type)   *type   = ip->orthog_type;
447
  if (refine) *refine = ip->orthog_ref;
448
  if (eta)    *eta    = ip->orthog_eta;
1345 slepc 449
  PetscFunctionReturn(0);
450
}
451
 
452
#undef __FUNCT__  
1302 slepc 453
#define __FUNCT__ "IPView"
1345 slepc 454
/*@C
455
   IPView - Prints the IP data structure.
456
 
457
   Collective on IP
458
 
459
   Input Parameters:
460
+  ip - the innerproduct context
461
-  viewer - optional visualization context
462
 
463
   Note:
464
   The available visualization contexts include
465
+     PETSC_VIEWER_STDOUT_SELF - standard output (default)
466
-     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
467
         output where only the first processor opens
468
         the file.  All other processors send their
469
         data to the first processor to print.
470
 
471
   The user can open an alternative visualization context with
472
   PetscViewerASCIIOpen() - output to a specified file.
473
 
474
   Level: beginner
475
 
2242 jroman 476
.seealso: EPSView(), SVDView(), PetscViewerASCIIOpen()
1345 slepc 477
@*/
1302 slepc 478
PetscErrorCode IPView(IP ip,PetscViewer viewer)
479
{
2317 jroman 480
  PetscBool      isascii;
1302 slepc 481
  PetscErrorCode ierr;
482
 
483
  PetscFunctionBegin;
2213 jroman 484
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
1422 slepc 485
  if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)ip)->comm);
2213 jroman 486
  PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
1302 slepc 487
  PetscCheckSameComm(ip,1,viewer,2);
2215 jroman 488
  ierr = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
1302 slepc 489
  if (isascii) {
2224 jroman 490
    ierr = PetscObjectPrintClassNamePrefixType((PetscObject)ip,viewer,"IP Object");CHKERRQ(ierr);
1302 slepc 491
    ierr = PetscViewerASCIIPrintf(viewer,"  orthogonalization method: ");CHKERRQ(ierr);
492
    switch (ip->orthog_type) {
2370 jroman 493
      case IP_ORTHOG_MGS:
1302 slepc 494
        ierr = PetscViewerASCIIPrintf(viewer,"modified Gram-Schmidt\n");CHKERRQ(ierr);
495
        break;
2370 jroman 496
      case IP_ORTHOG_CGS:
1302 slepc 497
        ierr = PetscViewerASCIIPrintf(viewer,"classical Gram-Schmidt\n");CHKERRQ(ierr);
498
        break;
2214 jroman 499
      default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_type");
1302 slepc 500
    }
501
    ierr = PetscViewerASCIIPrintf(viewer,"  orthogonalization refinement: ");CHKERRQ(ierr);
502
    switch (ip->orthog_ref) {
2370 jroman 503
      case IP_ORTHOG_REFINE_NEVER:
1302 slepc 504
        ierr = PetscViewerASCIIPrintf(viewer,"never\n");CHKERRQ(ierr);
505
        break;
2370 jroman 506
      case IP_ORTHOG_REFINE_IFNEEDED:
1302 slepc 507
        ierr = PetscViewerASCIIPrintf(viewer,"if needed (eta: %f)\n",ip->orthog_eta);CHKERRQ(ierr);
508
        break;
2370 jroman 509
      case IP_ORTHOG_REFINE_ALWAYS:
1302 slepc 510
        ierr = PetscViewerASCIIPrintf(viewer,"always\n");CHKERRQ(ierr);
511
        break;
2214 jroman 512
      default: SETERRQ(((PetscObject)ip)->comm,1,"Wrong value of ip->orth_ref");
1302 slepc 513
    }
514
  } else {
2214 jroman 515
    SETERRQ1(((PetscObject)ip)->comm,1,"Viewer type %s not supported for IP",((PetscObject)viewer)->type_name);
1302 slepc 516
  }
517
  PetscFunctionReturn(0);
518
}
519
 
520
#undef __FUNCT__  
2348 jroman 521
#define __FUNCT__ "IPReset"
522
/*@C
523
   IPReset - Resets the IP context to the initial state.
524
 
525
   Collective on IP
526
 
527
   Input Parameter:
528
.  ip - the inner product context
529
 
530
   Level: advanced
531
 
532
.seealso: IPDestroy()
533
@*/
534
PetscErrorCode IPReset(IP ip)
535
{
536
  PetscErrorCode ierr;
537
 
538
  PetscFunctionBegin;
539
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
540
  ierr = MatDestroy(&ip->matrix);CHKERRQ(ierr);
541
  ierr = VecDestroy(&ip->Bx);CHKERRQ(ierr);
2370 jroman 542
  ip->xid    = 0;
2348 jroman 543
  ip->xstate = 0;
544
  ierr = IPResetOperationCounters(ip);CHKERRQ(ierr);
545
  PetscFunctionReturn(0);
546
}
547
 
548
#undef __FUNCT__  
1302 slepc 549
#define __FUNCT__ "IPDestroy"
2312 jroman 550
/*@C
1345 slepc 551
   IPDestroy - Destroys IP context that was created with IPCreate().
552
 
553
   Collective on IP
554
 
555
   Input Parameter:
556
.  ip - the inner product context
557
 
558
   Level: beginner
559
 
560
.seealso: IPCreate()
561
@*/
2312 jroman 562
PetscErrorCode IPDestroy(IP *ip)
1302 slepc 563
{
564
  PetscErrorCode ierr;
565
 
566
  PetscFunctionBegin;
2312 jroman 567
  if (!*ip) PetscFunctionReturn(0);
568
  PetscValidHeaderSpecific(*ip,IP_CLASSID,1);
569
  if (--((PetscObject)(*ip))->refct > 0) { *ip = 0; PetscFunctionReturn(0); }
2348 jroman 570
  ierr = IPReset(*ip);CHKERRQ(ierr);
2312 jroman 571
  ierr = PetscHeaderDestroy(ip);CHKERRQ(ierr);
1302 slepc 572
  PetscFunctionReturn(0);
573
}
1329 slepc 574
 
575
#undef __FUNCT__  
576
#define __FUNCT__ "IPGetOperationCounters"
1345 slepc 577
/*@
578
   IPGetOperationCounters - Gets the total number of inner product operations
579
   made by the IP object.
580
 
581
   Not Collective
582
 
583
   Input Parameter:
584
.  ip - the inner product context
585
 
586
   Output Parameter:
587
.  dots - number of inner product operations
588
 
589
   Level: intermediate
590
 
591
.seealso: IPResetOperationCounters()
592
@*/
1509 slepc 593
PetscErrorCode IPGetOperationCounters(IP ip,PetscInt *dots)
1329 slepc 594
{
595
  PetscFunctionBegin;
2213 jroman 596
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
1329 slepc 597
  PetscValidPointer(dots,2);
598
  *dots = ip->innerproducts;
599
  PetscFunctionReturn(0);
600
}
601
 
602
#undef __FUNCT__  
603
#define __FUNCT__ "IPResetOperationCounters"
1345 slepc 604
/*@
605
   IPResetOperationCounters - Resets the counters for inner product operations
606
   made by of the IP object.
607
 
2328 jroman 608
   Logically Collective on IP
1345 slepc 609
 
610
   Input Parameter:
611
.  ip - the inner product context
612
 
613
   Level: intermediate
614
 
615
.seealso: IPGetOperationCounters()
616
@*/
1329 slepc 617
PetscErrorCode IPResetOperationCounters(IP ip)
618
{
619
  PetscFunctionBegin;
2213 jroman 620
  PetscValidHeaderSpecific(ip,IP_CLASSID,1);
1329 slepc 621
  ip->innerproducts = 0;
622
  PetscFunctionReturn(0);
623
}
624
 
2373 jroman 625
/*MC
626
   IPRegisterDynamic - Adds an inner product to the IP package.
627
 
628
   Synopsis:
629
   IPRegisterDynamic(char *name,char *path,char *name_create,PetscErrorCode (*routine_create)(IP))
630
 
631
   Not collective
632
 
633
   Input Parameters:
634
+  name - name of a new user-defined IP
635
.  path - path (either absolute or relative) the library containing this solver
636
.  name_create - name of routine to create context
637
-  routine_create - routine to create context
638
 
639
   Notes:
640
   IPRegisterDynamic() may be called multiple times to add several user-defined inner products.
641
 
642
   If dynamic libraries are used, then the fourth input argument (routine_create)
643
   is ignored.
644
 
645
   Level: advanced
646
 
647
.seealso: IPRegisterDestroy(), IPRegisterAll()
648
M*/
649
 
650
#undef __FUNCT__  
651
#define __FUNCT__ "IPRegister"
652
/*@C
653
   IPRegister - See IPRegisterDynamic()
654
 
655
   Level: advanced
656
@*/
657
PetscErrorCode IPRegister(const char *sname,const char *path,const char *name,PetscErrorCode (*function)(IP))
658
{
659
  PetscErrorCode ierr;
2374 jroman 660
  char           fullname[PETSC_MAX_PATH_LEN];
2373 jroman 661
 
662
  PetscFunctionBegin;
663
  ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
664
  ierr = PetscFListAdd(&IPList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
665
  PetscFunctionReturn(0);
666
}
667
 
668
#undef __FUNCT__  
669
#define __FUNCT__ "IPRegisterDestroy"
670
/*@
671
   IPRegisterDestroy - Frees the list of IP methods that were
672
   registered by IPRegisterDynamic().
673
 
674
   Not Collective
675
 
676
   Level: advanced
677
 
678
.seealso: IPRegisterDynamic(), IPRegisterAll()
679
@*/
680
PetscErrorCode IPRegisterDestroy(void)
681
{
682
  PetscErrorCode ierr;
683
 
684
  PetscFunctionBegin;
685
  ierr = PetscFListDestroy(&IPList);CHKERRQ(ierr);
686
  ierr = IPRegisterAll(PETSC_NULL);CHKERRQ(ierr);
687
  PetscFunctionReturn(0);
688
}
689
 
690
EXTERN_C_BEGIN
691
extern PetscErrorCode IPCreate_Bilinear(IP);
692
#if defined(PETSC_USE_COMPLEX)
693
extern PetscErrorCode IPCreate_Sesquilinear(IP);
694
#endif
695
EXTERN_C_END
696
 
697
#undef __FUNCT__  
698
#define __FUNCT__ "IPRegisterAll"
699
/*@C
700
   IPRegisterAll - Registers all of the inner products in the IP package.
701
 
702
   Not Collective
703
 
704
   Input Parameter:
705
.  path - the library where the routines are to be found (optional)
706
 
707
   Level: advanced
708
@*/
709
PetscErrorCode IPRegisterAll(const char *path)
710
{
711
  PetscErrorCode ierr;
712
 
713
  PetscFunctionBegin;
714
  ierr = IPRegisterDynamic(IPBILINEAR,path,"IPCreate_Bilinear",IPCreate_Bilinear);CHKERRQ(ierr);
715
#if defined(PETSC_USE_COMPLEX)
716
  ierr = IPRegisterDynamic(IPSESQUILINEAR,path,"IPCreate_Sesquilinear",IPCreate_Sesquilinear);CHKERRQ(ierr);
717
#endif
718
  PetscFunctionReturn(0);
719
}
720