Actual source code: reg.c

petsc-3.5.4 2015-05-23
Report Typos and Errors
  2: /*
  3:     Provides a general mechanism to allow one to register new routines in
  4:     dynamic libraries for many of the PETSc objects (including, e.g., KSP and PC).
  5: */
  6: #include <petsc-private/petscimpl.h>           /*I "petscsys.h" I*/
  7: #include <petscviewer.h>

  9: /*
 10:     This is the default list used by PETSc with the PetscDLLibrary register routines
 11: */
 12: PetscDLLibrary PetscDLLibrariesLoaded = 0;

 14: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)

 18: static PetscErrorCode  PetscLoadDynamicLibrary(const char *name,PetscBool  *found)
 19: {
 20:   char           libs[PETSC_MAX_PATH_LEN],dlib[PETSC_MAX_PATH_LEN];

 24:   PetscStrcpy(libs,"${PETSC_LIB_DIR}/libpetsc");
 25:   PetscStrcat(libs,name);
 26:   PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
 27:   if (*found) {
 28:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
 29:   } else {
 30:     PetscStrcpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc");
 31:     PetscStrcat(libs,name);
 32:     PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
 33:     if (*found) {
 34:       PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
 35:     }
 36:   }
 37:   return(0);
 38: }

 40: #endif

 44: /*
 45:     PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
 46:     search path.
 47: */
 48: PetscErrorCode  PetscInitialize_DynamicLibraries(void)
 49: {
 50:   char           *libname[32];
 52:   PetscInt       nmax,i;
 53: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 54:   PetscBool      preload;
 55: #endif

 58:   nmax = 32;
 59:   PetscOptionsGetStringArray(NULL,"-dll_prepend",libname,&nmax,NULL);
 60:   for (i=0; i<nmax; i++) {
 61:     PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
 62:     PetscFree(libname[i]);
 63:   }

 65: #if !defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 66:   /*
 67:       This just initializes the most basic PETSc stuff.

 69:     The classes, from PetscDraw to PetscTS, are initialized the first
 70:     time an XXCreate() is called.
 71:   */
 72:   PetscSysInitializePackage();
 73: #else
 74:   preload = PETSC_FALSE;
 75:   PetscOptionsGetBool(NULL,"-dynamic_library_preload",&preload,NULL);
 76:   if (preload) {
 77:     PetscBool found;
 78: #if defined(PETSC_USE_SINGLE_LIBRARY)
 79:     PetscLoadDynamicLibrary("",&found);
 80:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
 81: #else
 82:     PetscLoadDynamicLibrary("sys",&found);
 83:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
 84:     PetscLoadDynamicLibrary("vec",&found);
 85:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!");
 86:     PetscLoadDynamicLibrary("mat",&found);
 87:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!");
 88:     PetscLoadDynamicLibrary("dm",&found);
 89:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!");
 90:     PetscLoadDynamicLibrary("ksp",&found);
 91:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!");
 92:     PetscLoadDynamicLibrary("snes",&found);
 93:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!");
 94:     PetscLoadDynamicLibrary("ts",&found);
 95:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!");
 96: #endif
 97:   }
 98: #endif

100:   nmax = 32;
101:   PetscOptionsGetStringArray(NULL,"-dll_append",libname,&nmax,NULL);
102:   for (i=0; i<nmax; i++) {
103:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
104:     PetscFree(libname[i]);
105:   }
106:   return(0);
107: }

111: /*
112:      PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
113: */
114: PetscErrorCode PetscFinalize_DynamicLibraries(void)
115: {
117:   PetscBool      flg = PETSC_FALSE;

120:   PetscOptionsGetBool(NULL,"-dll_view",&flg,NULL);
121:   if (flg) { PetscDLLibraryPrintPath(PetscDLLibrariesLoaded); }
122:   PetscDLLibraryClose(PetscDLLibrariesLoaded);

124:   PetscDLLibrariesLoaded = 0;
125:   return(0);
126: }



130: /* ------------------------------------------------------------------------------*/
131: struct _n_PetscFunctionList {
132:   void              (*routine)(void);    /* the routine */
133:   char              *name;               /* string to identify routine */
134:   PetscFunctionList next;                /* next pointer */
135:   PetscFunctionList next_list;           /* used to maintain list of all lists for freeing */
136: };

138: /*
139:      Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
140: */
141: static PetscFunctionList dlallhead = 0;

143: /*MC
144:    PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
145:    specified registry.

147:    Synopsis:
148:    #include <petscsys.h>
149:    PetscErrorCode PetscFunctionListAdd(PetscFunctionList flist,const char name[],void (*fptr)(void))

151:    Not Collective

153:    Input Parameters:
154: +  flist - pointer registry
155: .  name - string to identify routine
156: -  fptr - function pointer

158:    Notes:
159:    To remove a registered routine, pass in a NULL fptr.

161:    Users who wish to register new classes for use by a particular PETSc
162:    component (e.g., SNES) should generally call the registration routine
163:    for that particular component (e.g., SNESRegister()) instead of
164:    calling PetscFunctionListAdd() directly.

166:     Level: developer

168: .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
169:           PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
170: M*/
173: PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
174: {
175:   PetscFunctionList entry,ne;
176:   PetscErrorCode    ierr;

179:   if (!*fl) {
180:     PetscNew(&entry);
181:     PetscStrallocpy(name,&entry->name);
182:     entry->routine = fnc;
183:     entry->next    = 0;
184:     *fl            = entry;

186:     /* add this new list to list of all lists */
187:     if (!dlallhead) {
188:       dlallhead        = *fl;
189:       (*fl)->next_list = 0;
190:     } else {
191:       ne               = dlallhead;
192:       dlallhead        = *fl;
193:       (*fl)->next_list = ne;
194:     }
195:   } else {
196:     /* search list to see if it is already there */
197:     ne = *fl;
198:     while (ne) {
199:       PetscBool founddup;

201:       PetscStrcmp(ne->name,name,&founddup);
202:       if (founddup) { /* found duplicate */
203:         ne->routine = fnc;
204:         return(0);
205:       }
206:       if (ne->next) ne = ne->next;
207:       else break;
208:     }
209:     /* create new entry and add to end of list */
210:     PetscNew(&entry);
211:     PetscStrallocpy(name,&entry->name);
212:     entry->routine = fnc;
213:     entry->next    = 0;
214:     ne->next       = entry;
215:   }
216:   return(0);
217: }

221: /*@
222:     PetscFunctionListDestroy - Destroys a list of registered routines.

224:     Input Parameter:
225: .   fl  - pointer to list

227:     Level: developer

229: .seealso: PetscFunctionListAdd(), PetscFunctionList
230: @*/
231: PetscErrorCode  PetscFunctionListDestroy(PetscFunctionList *fl)
232: {
233:   PetscFunctionList next,entry,tmp = dlallhead;
234:   PetscErrorCode    ierr;

237:   if (!*fl) return(0);

239:   /*
240:        Remove this entry from the master DL list (if it is in it)
241:   */
242:   if (dlallhead == *fl) {
243:     if (dlallhead->next_list) dlallhead = dlallhead->next_list;
244:     else dlallhead = NULL;
245:   } else if (tmp) {
246:     while (tmp->next_list != *fl) {
247:       tmp = tmp->next_list;
248:       if (!tmp->next_list) break;
249:     }
250:     if (tmp->next_list) tmp->next_list = tmp->next_list->next_list;
251:   }

253:   /* free this list */
254:   entry = *fl;
255:   while (entry) {
256:     next  = entry->next;
257:     PetscFree(entry->name);
258:     PetscFree(entry);
259:     entry = next;
260:   }
261:   *fl = 0;
262:   return(0);
263: }

265: /*
266:    Print any PetscFunctionLists that have not be destroyed
267: */
270: PetscErrorCode  PetscFunctionListPrintAll(void)
271: {
272:   PetscFunctionList tmp = dlallhead;
273:   PetscErrorCode    ierr;

276:   if (tmp) {
277:     PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");
278:   }
279:   while (tmp) {
280:     PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);
281:     tmp = tmp->next_list;
282:   }
283:   return(0);
284: }

286: /*MC
287:     PetscFunctionListFind - Find function registered under given name

289:     Synopsis:
290:     #include <petscsys.h>
291:     PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void))

293:     Input Parameters:
294: +   flist   - pointer to list
295: -   name - name registered for the function

297:     Output Parameters:
298: .   fptr - the function pointer if name was found, else NULL

300:     Level: developer

302: .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
303: M*/
306: PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void))
307: {
308:   PetscFunctionList entry = fl;
309:   PetscErrorCode    ierr;
310:   PetscBool         flg;

313:   if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name");

315:   *r = 0;
316:   while (entry) {
317:     PetscStrcmp(name,entry->name,&flg);
318:     if (flg) {
319:       *r   = entry->routine;
320:       return(0);
321:     }
322:     entry = entry->next;
323:   }
324:   return(0);
325: }

329: /*@
330:    PetscFunctionListView - prints out contents of an PetscFunctionList

332:    Collective over MPI_Comm

334:    Input Parameters:
335: +  list - the list of functions
336: -  viewer - currently ignored

338:    Level: developer

340: .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
341: @*/
342: PetscErrorCode  PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
343: {
345:   PetscBool      iascii;

348:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;

352:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
353:   if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported");

355:   while (list) {
356:     PetscViewerASCIIPrintf(viewer," %s\n",list->name);
357:     list = list->next;
358:   }
359:   PetscViewerASCIIPrintf(viewer,"\n");
360:   return(0);
361: }

365: /*@C
366:    PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
367:          by help etc.

369:    Not Collective

371:    Input Parameter:
372: .  list   - list of types

374:    Output Parameter:
375: +  array - array of names
376: -  n - length of array

378:    Notes:
379:        This allocates the array so that must be freed. BUT the individual entries are
380:     not copied so should not be freed.

382:    Level: developer

384: .seealso: PetscFunctionListAdd(), PetscFunctionList
385: @*/
386: PetscErrorCode  PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
387: {
388:   PetscErrorCode    ierr;
389:   PetscInt          count = 0;
390:   PetscFunctionList klist = list;

393:   while (list) {
394:     list = list->next;
395:     count++;
396:   }
397:   PetscMalloc1((count+1),array);
398:   count = 0;
399:   while (klist) {
400:     (*array)[count] = klist->name;
401:     klist           = klist->next;
402:     count++;
403:   }
404:   (*array)[count] = 0;
405:   *n              = count+1;
406:   return(0);
407: }


412: /*@C
413:    PetscFunctionListPrintTypes - Prints the methods available.

415:    Collective over MPI_Comm

417:    Input Parameters:
418: +  comm   - the communicator (usually MPI_COMM_WORLD)
419: .  fd     - file to print to, usually stdout
420: .  prefix - prefix to prepend to name (optional)
421: .  name   - option string (for example, "-ksp_type")
422: .  text - short description of the object (for example, "Krylov solvers")
423: .  man - name of manual page that discusses the object (for example, "KSPCreate")
424: .  list   - list of types
425: -  def - default (current) value

427:    Level: developer

429: .seealso: PetscFunctionListAdd(), PetscFunctionList
430: @*/
431: PetscErrorCode  PetscFunctionListPrintTypes(MPI_Comm comm,FILE *fd,const char prefix[],const char name[],const char text[],const char man[],PetscFunctionList list,const char def[])
432: {
434:   PetscInt       count = 0;
435:   char           p[64];

438:   if (!fd) fd = PETSC_STDOUT;

440:   PetscStrcpy(p,"-");
441:   if (prefix) {PetscStrcat(p,prefix);}
442:   PetscFPrintf(comm,fd,"  %s%s <%s>: %s (one of)",p,name+1,def,text);

444:   while (list) {
445:     PetscFPrintf(comm,fd," %s",list->name);
446:     list = list->next;
447:     count++;
448:     if (count == 8) {PetscFPrintf(comm,fd,"\n     ");}
449:   }
450:   PetscFPrintf(comm,fd," (%s)\n",man);
451:   return(0);
452: }

456: /*@
457:     PetscFunctionListDuplicate - Creates a new list from a given object list.

459:     Input Parameters:
460: .   fl   - pointer to list

462:     Output Parameters:
463: .   nl - the new list (should point to 0 to start, otherwise appends)

465:     Level: developer

467: .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy()

469: @*/
470: PetscErrorCode  PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
471: {

475:   while (fl) {
476:     PetscFunctionListAdd(nl,fl->name,fl->routine);
477:     fl   = fl->next;
478:   }
479:   return(0);
480: }