Actual source code: ipbasic.c

  1: /*
  2:      Basic routines

  4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  6:    Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain

  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.

 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.

 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/>.
 21:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 22: */

 24:  #include private/ipimpl.h

 26: PetscCookie IP_COOKIE = 0;
 27: PetscLogEvent IP_InnerProduct = 0, IP_Orthogonalize = 0, IP_ApplyMatrix = 0;

 31: /*@C
 32:   IPInitializePackage - This function initializes everything in the IP package. It is called
 33:   from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to IPCreate()
 34:   when using static libraries.

 36:   Input Parameter:
 37:   path - The dynamic library path, or PETSC_NULL

 39:   Level: developer

 41: .seealso: SlepcInitialize()
 42: @*/
 43: PetscErrorCode IPInitializePackage(char *path)
 44: {
 45:   static PetscTruth initialized = PETSC_FALSE;
 46:   char              logList[256];
 47:   char              *className;
 48:   PetscTruth        opt;
 49:   PetscErrorCode    ierr;

 52:   if (initialized) return(0);
 53:   initialized = PETSC_TRUE;
 54:   /* Register Classes */
 55:   PetscCookieRegister("Inner product",&IP_COOKIE);
 56:   /* Register Events */
 57:   PetscLogEventRegister("IPOrthogonalize",IP_COOKIE,&IP_Orthogonalize);
 58:   PetscLogEventRegister("IPInnerProduct",IP_COOKIE,&IP_InnerProduct);
 59:   PetscLogEventRegister("IPApplyMatrix",IP_COOKIE,&IP_ApplyMatrix);
 60:   /* Process info exclusions */
 61:   PetscOptionsGetString(PETSC_NULL, "-log_info_exclude", logList, 256, &opt);
 62:   if (opt) {
 63:     PetscStrstr(logList, "ip", &className);
 64:     if (className) {
 65:       PetscInfoDeactivateClass(IP_COOKIE);
 66:     }
 67:   }
 68:   /* Process summary exclusions */
 69:   PetscOptionsGetString(PETSC_NULL, "-log_summary_exclude", logList, 256, &opt);
 70:   if (opt) {
 71:     PetscStrstr(logList, "ip", &className);
 72:     if (className) {
 73:       PetscLogEventDeactivateClass(IP_COOKIE);
 74:     }
 75:   }
 76:   return(0);
 77: }

 81: /*@C
 82:    IPCreate - Creates an IP context.

 84:    Collective on MPI_Comm

 86:    Input Parameter:
 87: .  comm - MPI communicator

 89:    Output Parameter:
 90: .  newip - location to put the IP context

 92:    Level: beginner

 94:    Note: 
 95:    IP objects are not intended for normal users but only for
 96:    advanced user that for instance implement their own solvers.

 98: .seealso: IPDestroy(), IP
 99: @*/
100: PetscErrorCode IPCreate(MPI_Comm comm,IP *newip)
101: {
103:   IP ip;

107:   PetscHeaderCreate(ip,_p_IP,int,IP_COOKIE,-1,"IP",comm,IPDestroy,IPView);
108:   *newip            = ip;
109:   ip->orthog_type   = IP_ORTH_CGS;
110:   ip->orthog_ref    = IP_ORTH_REFINE_IFNEEDED;
111:   ip->orthog_eta    = 0.7071;
112:   ip->bilinear_form = IP_INNER_HERMITIAN;
113:   ip->innerproducts = 0;
114:   ip->matrix        = PETSC_NULL;
115:   ip->Bx            = PETSC_NULL;
116:   ip->xid           = 0;
117:   ip->xstate        = 0;

119:   PetscPublishAll(ip);
120:   return(0);
121: }

125: /*@C
126:    IPSetOptionsPrefix - Sets the prefix used for searching for all 
127:    IP options in the database.

129:    Collective on IP

131:    Input Parameters:
132: +  ip - the innerproduct context
133: -  prefix - the prefix string to prepend to all IP option requests

135:    Notes:
136:    A hyphen (-) must NOT be given at the beginning of the prefix name.
137:    The first character of all runtime options is AUTOMATICALLY the
138:    hyphen.

140:    Level: advanced

142: .seealso: IPAppendOptionsPrefix()
143: @*/
144: PetscErrorCode IPSetOptionsPrefix(IP ip,const char *prefix)
145: {
149:   PetscObjectSetOptionsPrefix((PetscObject)ip,prefix);
150:   return(0);
151: }

155: /*@C
156:    IPAppendOptionsPrefix - Appends to the prefix used for searching for all 
157:    IP options in the database.

159:    Collective on IP

161:    Input Parameters:
162: +  ip - the innerproduct context
163: -  prefix - the prefix string to prepend to all IP option requests

165:    Notes:
166:    A hyphen (-) must NOT be given at the beginning of the prefix name.
167:    The first character of all runtime options is AUTOMATICALLY the hyphen.

169:    Level: advanced

171: .seealso: IPSetOptionsPrefix()
172: @*/
173: PetscErrorCode IPAppendOptionsPrefix(IP ip,const char *prefix)
174: {
178:   PetscObjectAppendOptionsPrefix((PetscObject)ip,prefix);
179:   return(0);
180: }

184: /*@C
185:    IPGetOptionsPrefix - Gets the prefix used for searching for all 
186:    IP options in the database.

188:    Not Collective

190:    Input Parameters:
191: .  ip - the innerproduct context

193:    Output Parameters:
194: .  prefix - pointer to the prefix string used is returned

196:    Notes: On the fortran side, the user should pass in a string 'prefix' of
197:    sufficient length to hold the prefix.

199:    Level: advanced

201: .seealso: IPSetOptionsPrefix(), IPAppendOptionsPrefix()
202: @*/
203: PetscErrorCode IPGetOptionsPrefix(IP ip,const char *prefix[])
204: {
209:  PetscObjectGetOptionsPrefix((PetscObject)ip, prefix);
210:  return(0);
211: }


216: /*@
217:    IPSetFromOptions - Sets IP options from the options database.

219:    Collective on IP

221:    Input Parameters:
222: .  ip - the innerproduct context

224:    Notes:  
225:    To see all options, run your program with the -help option.

227:    Level: beginner

229: .seealso: 
230: @*/
231: PetscErrorCode IPSetFromOptions(IP ip)
232: {
234:   const char     *orth_list[2] = { "mgs" , "cgs" };
235:   const char     *ref_list[3] = { "never" , "ifneeded", "always" };
236:   PetscReal      r;
237:   PetscInt       i,j;

241:   PetscOptionsBegin(((PetscObject)ip)->comm,((PetscObject)ip)->prefix,"Inner Product (IP) Options","IP");
242:   i = ip->orthog_type;
243:   PetscOptionsEList("-orthog_type","Orthogonalization method","IPSetOrthogonalization",orth_list,2,orth_list[i],&i,PETSC_NULL);
244:   j = ip->orthog_ref;
245:   PetscOptionsEList("-orthog_refinement","Iterative refinement mode during orthogonalization","IPSetOrthogonalization",ref_list,3,ref_list[j],&j,PETSC_NULL);
246:   r = ip->orthog_eta;
247:   PetscOptionsReal("-orthog_eta","Parameter of iterative refinement during orthogonalization","IPSetOrthogonalization",r,&r,PETSC_NULL);
248:   IPSetOrthogonalization(ip,(IPOrthogonalizationType)i,(IPOrthogonalizationRefinementType)j,r);
249:   PetscOptionsEnd();
250:   return(0);
251: }

255: /*@
256:    IPSetOrthogonalization - Specifies the type of orthogonalization technique
257:    to be used (classical or modified Gram-Schmidt with or without refinement).

259:    Collective on IP

261:    Input Parameters:
262: +  ip         - the innerproduct context
263: .  type       - the type of orthogonalization technique
264: .  refinement - type of refinement
265: -  eta        - parameter for selective refinement

267:    Options Database Keys:
268: +  -orthog_type <type> -  Where <type> is cgs for Classical Gram-Schmidt
269:                               orthogonalization (default)
270:                               or mgs for Modified Gram-Schmidt orthogonalization
271: .  -orthog_refinement <type> -  Where <type> is one of never, ifneeded
272:                               (default) or always 
273: -  -orthog_eta <eta> -  For setting the value of eta
274:     
275:    Notes:  
276:    The default settings work well for most problems. 

278:    The parameter eta should be a real value between 0 and 1 (or PETSC_DEFAULT).
279:    The value of eta is used only when the refinement type is "ifneeded". 

281:    When using several processors, MGS is likely to result in bad scalability.

283:    Level: advanced

285: .seealso: IPOrthogonalize(), IPGetOrthogonalization(), IPOrthogonalizationType,
286:           IPOrthogonalizationRefinementType
287: @*/
288: PetscErrorCode IPSetOrthogonalization(IP ip,IPOrthogonalizationType type, IPOrthogonalizationRefinementType refinement, PetscReal eta)
289: {
292:   switch (type) {
293:     case IP_ORTH_CGS:
294:     case IP_ORTH_MGS:
295:       ip->orthog_type = type;
296:       break;
297:     default:
298:       SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type");
299:   }
300:   switch (refinement) {
301:     case IP_ORTH_REFINE_NEVER:
302:     case IP_ORTH_REFINE_IFNEEDED:
303:     case IP_ORTH_REFINE_ALWAYS:
304:       ip->orthog_ref = refinement;
305:       break;
306:     default:
307:       SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown refinement type");
308:   }
309:   if (eta == PETSC_DEFAULT) {
310:     ip->orthog_eta = 0.7071;
311:   } else {
312:     if (eta <= 0.0 || eta > 1.0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid eta value");
313:     ip->orthog_eta = eta;
314:   }
315:   return(0);
316: }

320: /*@C
321:    IPGetOrthogonalization - Gets the orthogonalization settings from the 
322:    IP object.

324:    Not Collective

326:    Input Parameter:
327: .  ip - inner product context 

329:    Output Parameter:
330: +  type       - type of orthogonalization technique
331: .  refinement - type of refinement
332: -  eta        - parameter for selective refinement

334:    Level: advanced

336: .seealso: IPOrthogonalize(), IPSetOrthogonalization(), IPOrthogonalizationType,
337:           IPOrthogonalizationRefinementType
338: @*/
339: PetscErrorCode IPGetOrthogonalization(IP ip,IPOrthogonalizationType *type,IPOrthogonalizationRefinementType *refinement, PetscReal *eta)
340: {
343:   if (type) *type = ip->orthog_type;
344:   if (refinement) *refinement = ip->orthog_ref;
345:   if (eta) *eta = ip->orthog_eta;
346:   return(0);
347: }

351: /*@C
352:    IPView - Prints the IP data structure.

354:    Collective on IP

356:    Input Parameters:
357: +  ip - the innerproduct context
358: -  viewer - optional visualization context

360:    Note:
361:    The available visualization contexts include
362: +     PETSC_VIEWER_STDOUT_SELF - standard output (default)
363: -     PETSC_VIEWER_STDOUT_WORLD - synchronized standard
364:          output where only the first processor opens
365:          the file.  All other processors send their 
366:          data to the first processor to print. 

368:    The user can open an alternative visualization context with
369:    PetscViewerASCIIOpen() - output to a specified file.

371:    Level: beginner

373: .seealso: IPView(), EPSView(), SVDView(), PetscViewerASCIIOpen()
374: @*/
375: PetscErrorCode IPView(IP ip,PetscViewer viewer)
376: {
378:   PetscTruth     isascii;

382:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)ip)->comm);

386:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
387:   if (isascii) {
388:     PetscViewerASCIIPrintf(viewer,"IP Object:\n");
389:     PetscViewerASCIIPrintf(viewer,"  orthogonalization method: ");
390:     switch (ip->orthog_type) {
391:       case IP_ORTH_MGS:
392:         PetscViewerASCIIPrintf(viewer,"modified Gram-Schmidt\n");
393:         break;
394:       case IP_ORTH_CGS:
395:         PetscViewerASCIIPrintf(viewer,"classical Gram-Schmidt\n");
396:         break;
397:       default: SETERRQ(1,"Wrong value of ip->orth_type");
398:     }
399:     PetscViewerASCIIPrintf(viewer,"  orthogonalization refinement: ");
400:     switch (ip->orthog_ref) {
401:       case IP_ORTH_REFINE_NEVER:
402:         PetscViewerASCIIPrintf(viewer,"never\n");
403:         break;
404:       case IP_ORTH_REFINE_IFNEEDED:
405:         PetscViewerASCIIPrintf(viewer,"if needed (eta: %f)\n",ip->orthog_eta);
406:         break;
407:       case IP_ORTH_REFINE_ALWAYS:
408:         PetscViewerASCIIPrintf(viewer,"always\n");
409:         break;
410:       default: SETERRQ(1,"Wrong value of ip->orth_ref");
411:     }
412:   } else {
413:     SETERRQ1(1,"Viewer type %s not supported for IP",((PetscObject)viewer)->type_name);
414:   }
415:   return(0);
416: }

420: /*@
421:    IPDestroy - Destroys IP context that was created with IPCreate().

423:    Collective on IP

425:    Input Parameter:
426: .  ip - the inner product context

428:    Level: beginner

430: .seealso: IPCreate()
431: @*/
432: PetscErrorCode IPDestroy(IP ip)
433: {

438:   if (--((PetscObject)ip)->refct > 0) return(0);

440:   if (ip->matrix) { MatDestroy(ip->matrix); }
441:   if (ip->Bx) { VecDestroy(ip->Bx); }
442:   PetscHeaderDestroy(ip);
443:   return(0);
444: }

448: /*@
449:    IPGetOperationCounters - Gets the total number of inner product operations 
450:    made by the IP object.

452:    Not Collective

454:    Input Parameter:
455: .  ip - the inner product context

457:    Output Parameter:
458: .  dots - number of inner product operations
459:    
460:    Level: intermediate

462: .seealso: IPResetOperationCounters()
463: @*/
464: PetscErrorCode IPGetOperationCounters(IP ip,PetscInt *dots)
465: {
469:   *dots = ip->innerproducts;
470:   return(0);
471: }

475: /*@
476:    IPResetOperationCounters - Resets the counters for inner product operations 
477:    made by of the IP object.

479:    Collective on IP

481:    Input Parameter:
482: .  ip - the inner product context

484:    Level: intermediate

486: .seealso: IPGetOperationCounters()
487: @*/
488: PetscErrorCode IPResetOperationCounters(IP ip)
489: {
492:   ip->innerproducts = 0;
493:   return(0);
494: }