Subversion Repositories slepc-dev

Rev

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