1
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>
8
9 /*
10 This is the default list used by PETSc with the PetscDLLibrary register routines
11 */
12 PetscDLLibrary PetscDLLibrariesLoaded = NULL;
13
14 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
15
PetscLoadDynamicLibrary(const char * name,PetscBool * found)16 PetscErrorCode PetscLoadDynamicLibrary(const char *name,PetscBool *found)
17 {
18 char libs[PETSC_MAX_PATH_LEN],dlib[PETSC_MAX_PATH_LEN];
19 PetscErrorCode ierr;
20
21 PetscFunctionBegin;
22 ierr = PetscStrncpy(libs,"${PETSC_LIB_DIR}/libpetsc",sizeof(libs));CHKERRQ(ierr);
23 ierr = PetscStrlcat(libs,name,sizeof(libs));CHKERRQ(ierr);
24 ierr = PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);CHKERRQ(ierr);
25 if (*found) {
26 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);CHKERRQ(ierr);
27 } else {
28 ierr = PetscStrncpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc",sizeof(libs));CHKERRQ(ierr);
29 ierr = PetscStrlcat(libs,name,sizeof(libs));CHKERRQ(ierr);
30 ierr = PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);CHKERRQ(ierr);
31 if (*found) {
32 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);CHKERRQ(ierr);
33 }
34 }
35 PetscFunctionReturn(0);
36 }
37 #endif
38
39 #if defined(PETSC_HAVE_THREADSAFETY)
40 PETSC_EXTERN PetscErrorCode AOInitializePackage(void);
41 PETSC_EXTERN PetscErrorCode PetscSFInitializePackage(void);
42 #if !defined(PETSC_USE_COMPLEX)
43 PETSC_EXTERN PetscErrorCode CharacteristicInitializePackage(void);
44 #endif
45 PETSC_EXTERN PetscErrorCode ISInitializePackage(void);
46 PETSC_EXTERN PetscErrorCode VecInitializePackage(void);
47 PETSC_EXTERN PetscErrorCode MatInitializePackage(void);
48 PETSC_EXTERN PetscErrorCode DMInitializePackage(void);
49 PETSC_EXTERN PetscErrorCode PCInitializePackage(void);
50 PETSC_EXTERN PetscErrorCode KSPInitializePackage(void);
51 PETSC_EXTERN PetscErrorCode SNESInitializePackage(void);
52 PETSC_EXTERN PetscErrorCode TSInitializePackage(void);
53 static MPI_Comm PETSC_COMM_WORLD_INNER = 0,PETSC_COMM_SELF_INNER = 0;
54 #endif
55
56 /*
57 PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
58 search path.
59 */
PetscInitialize_DynamicLibraries(void)60 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void)
61 {
62 char *libname[32];
63 PetscErrorCode ierr;
64 PetscInt nmax,i;
65 #if defined(PETSC_USE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
66 PetscBool preload;
67 #endif
68 #if defined(PETSC_HAVE_ELEMENTAL)
69 PetscBool PetscInitialized = PetscInitializeCalled;
70 #endif
71
72 PetscFunctionBegin;
73 nmax = 32;
74 ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);CHKERRQ(ierr);
75 for (i=0; i<nmax; i++) {
76 ierr = PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr);
77 ierr = PetscFree(libname[i]);CHKERRQ(ierr);
78 }
79
80 #if !defined(PETSC_USE_DYNAMIC_LIBRARIES) || !defined(PETSC_USE_SHARED_LIBRARIES)
81 /*
82 This just initializes the most basic PETSc stuff.
83
84 The classes, from PetscDraw to PetscTS, are initialized the first
85 time an XXCreate() is called.
86 */
87 ierr = PetscSysInitializePackage();CHKERRQ(ierr);
88 #else
89 preload = PETSC_FALSE;
90 ierr = PetscOptionsGetBool(NULL,NULL,"-dynamic_library_preload",&preload,NULL);CHKERRQ(ierr);
91 if (preload) {
92 PetscBool found;
93 #if defined(PETSC_USE_SINGLE_LIBRARY)
94 ierr = PetscLoadDynamicLibrary("",&found);CHKERRQ(ierr);
95 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
96 #else
97 ierr = PetscLoadDynamicLibrary("sys",&found);CHKERRQ(ierr);
98 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
99 ierr = PetscLoadDynamicLibrary("vec",&found);CHKERRQ(ierr);
100 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!");
101 ierr = PetscLoadDynamicLibrary("mat",&found);CHKERRQ(ierr);
102 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!");
103 ierr = PetscLoadDynamicLibrary("dm",&found);CHKERRQ(ierr);
104 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!");
105 ierr = PetscLoadDynamicLibrary("ksp",&found);CHKERRQ(ierr);
106 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!");
107 ierr = PetscLoadDynamicLibrary("snes",&found);CHKERRQ(ierr);
108 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!");
109 ierr = PetscLoadDynamicLibrary("ts",&found);CHKERRQ(ierr);
110 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!");
111 #endif
112 }
113 #endif
114 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
115 #if defined(PETSC_HAVE_BAMG)
116 {
117 PetscBool found;
118 ierr = PetscLoadDynamicLibrary("bamg",&found);CHKERRQ(ierr);
119 if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc BAMG dynamic library \n You cannot move the dynamic libraries!");
120 }
121 #endif
122 #endif
123
124 nmax = 32;
125 ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);CHKERRQ(ierr);
126 for (i=0; i<nmax; i++) {
127 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr);
128 ierr = PetscFree(libname[i]);CHKERRQ(ierr);
129 }
130
131 #if defined(PETSC_HAVE_THREADSAFETY)
132 /* These must be done here because it is not safe for individual threads to call these initialize routines */
133 ierr = AOInitializePackage();CHKERRQ(ierr);
134 ierr = PetscSFInitializePackage();CHKERRQ(ierr);
135 #if !defined(PETSC_USE_COMPLEX)
136 ierr = CharacteristicInitializePackage();CHKERRQ(ierr);
137 #endif
138 ierr = ISInitializePackage();CHKERRQ(ierr);
139 ierr = VecInitializePackage();CHKERRQ(ierr);
140 ierr = MatInitializePackage();CHKERRQ(ierr);
141 ierr = DMInitializePackage();CHKERRQ(ierr);
142 ierr = PCInitializePackage();CHKERRQ(ierr);
143 ierr = KSPInitializePackage();CHKERRQ(ierr);
144 ierr = SNESInitializePackage();CHKERRQ(ierr);
145 ierr = TSInitializePackage();CHKERRQ(ierr);
146 ierr = PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);CHKERRQ(ierr);
147 ierr = PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);CHKERRQ(ierr);
148 #endif
149 #if defined(PETSC_HAVE_ELEMENTAL)
150 /* in Fortran, PetscInitializeCalled is set to PETSC_TRUE before PetscInitialize_DynamicLibraries() */
151 /* in C, it is not the case, but the value is forced to PETSC_TRUE so that PetscRegisterFinalize() is called */
152 PetscInitializeCalled = PETSC_TRUE;
153 ierr = PetscElementalInitializePackage();CHKERRQ(ierr);
154 PetscInitializeCalled = PetscInitialized;
155 #endif
156 PetscFunctionReturn(0);
157 }
158
159 /*
160 PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
161 */
PetscFinalize_DynamicLibraries(void)162 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
163 {
164 PetscErrorCode ierr;
165 PetscBool flg = PETSC_FALSE;
166
167 PetscFunctionBegin;
168 ierr = PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);CHKERRQ(ierr);
169 if (flg) { ierr = PetscDLLibraryPrintPath(PetscDLLibrariesLoaded);CHKERRQ(ierr); }
170 ierr = PetscDLLibraryClose(PetscDLLibrariesLoaded);CHKERRQ(ierr);
171
172 #if defined(PETSC_HAVE_THREADSAFETY)
173 ierr = PetscCommDestroy(&PETSC_COMM_SELF_INNER);CHKERRQ(ierr);
174 ierr = PetscCommDestroy(&PETSC_COMM_WORLD_INNER);CHKERRQ(ierr);
175 #endif
176
177 PetscDLLibrariesLoaded = NULL;
178 PetscFunctionReturn(0);
179 }
180
181
182
183 /* ------------------------------------------------------------------------------*/
184 struct _n_PetscFunctionList {
185 void (*routine)(void); /* the routine */
186 char *name; /* string to identify routine */
187 PetscFunctionList next; /* next pointer */
188 PetscFunctionList next_list; /* used to maintain list of all lists for freeing */
189 };
190
191 /*
192 Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
193 */
194 static PetscFunctionList dlallhead = NULL;
195
196 /*MC
197 PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
198 specified registry.
199
200 Synopsis:
201 #include <petscsys.h>
202 PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void))
203
204 Not Collective
205
206 Input Parameters:
207 + flist - pointer to function list object
208 . name - string to identify routine
209 - fptr - function pointer
210
211 Notes:
212 To remove a registered routine, pass in a NULL fptr.
213
214 Users who wish to register new classes for use by a particular PETSc
215 component (e.g., SNES) should generally call the registration routine
216 for that particular component (e.g., SNESRegister()) instead of
217 calling PetscFunctionListAdd() directly.
218
219 Level: developer
220
221 .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
222 PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
223 M*/
PetscFunctionListAdd_Private(PetscFunctionList * fl,const char name[],void (* fnc)(void))224 PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
225 {
226 PetscFunctionList entry,ne;
227 PetscErrorCode ierr;
228
229 PetscFunctionBegin;
230 if (!*fl) {
231 ierr = PetscNew(&entry);CHKERRQ(ierr);
232 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr);
233 entry->routine = fnc;
234 entry->next = NULL;
235 *fl = entry;
236
237 if (PetscDefined(USE_DEBUG)) {
238 /* add this new list to list of all lists */
239 if (!dlallhead) {
240 dlallhead = *fl;
241 (*fl)->next_list = NULL;
242 } else {
243 ne = dlallhead;
244 dlallhead = *fl;
245 (*fl)->next_list = ne;
246 }
247 }
248
249 } else {
250 /* search list to see if it is already there */
251 ne = *fl;
252 while (ne) {
253 PetscBool founddup;
254
255 ierr = PetscStrcmp(ne->name,name,&founddup);CHKERRQ(ierr);
256 if (founddup) { /* found duplicate */
257 ne->routine = fnc;
258 PetscFunctionReturn(0);
259 }
260 if (ne->next) ne = ne->next;
261 else break;
262 }
263 /* create new entry and add to end of list */
264 ierr = PetscNew(&entry);CHKERRQ(ierr);
265 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr);
266 entry->routine = fnc;
267 entry->next = NULL;
268 ne->next = entry;
269 }
270 PetscFunctionReturn(0);
271 }
272
273 /*@
274 PetscFunctionListDestroy - Destroys a list of registered routines.
275
276 Input Parameter:
277 . fl - pointer to list
278
279 Level: developer
280
281 .seealso: PetscFunctionListAdd(), PetscFunctionList
282 @*/
PetscFunctionListDestroy(PetscFunctionList * fl)283 PetscErrorCode PetscFunctionListDestroy(PetscFunctionList *fl)
284 {
285 PetscFunctionList next,entry,tmp = dlallhead;
286 PetscErrorCode ierr;
287
288 PetscFunctionBegin;
289 if (!*fl) PetscFunctionReturn(0);
290
291 /*
292 Remove this entry from the master DL list (if it is in it)
293 */
294 if (dlallhead == *fl) {
295 if (dlallhead->next_list) dlallhead = dlallhead->next_list;
296 else dlallhead = NULL;
297 } else if (tmp) {
298 while (tmp->next_list != *fl) {
299 tmp = tmp->next_list;
300 if (!tmp->next_list) break;
301 }
302 if (tmp->next_list) tmp->next_list = tmp->next_list->next_list;
303 }
304
305 /* free this list */
306 entry = *fl;
307 while (entry) {
308 next = entry->next;
309 ierr = PetscFree(entry->name);CHKERRQ(ierr);
310 ierr = PetscFree(entry);CHKERRQ(ierr);
311 entry = next;
312 }
313 *fl = NULL;
314 PetscFunctionReturn(0);
315 }
316
317 /*
318 Print any PetscFunctionLists that have not be destroyed
319 */
PetscFunctionListPrintAll(void)320 PetscErrorCode PetscFunctionListPrintAll(void)
321 {
322 PetscFunctionList tmp = dlallhead;
323 PetscErrorCode ierr;
324
325 PetscFunctionBegin;
326 if (tmp) {
327 ierr = PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");CHKERRQ(ierr);
328 }
329 while (tmp) {
330 ierr = PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);CHKERRQ(ierr);
331 tmp = tmp->next_list;
332 }
333 PetscFunctionReturn(0);
334 }
335
336 /*MC
337 PetscFunctionListFind - Find function registered under given name
338
339 Synopsis:
340 #include <petscsys.h>
341 PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void))
342
343 Input Parameters:
344 + flist - pointer to list
345 - name - name registered for the function
346
347 Output Parameters:
348 . fptr - the function pointer if name was found, else NULL
349
350 Level: developer
351
352 .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
353 M*/
PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (** r)(void))354 PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void))
355 {
356 PetscFunctionList entry = fl;
357 PetscErrorCode ierr;
358 PetscBool flg;
359
360 PetscFunctionBegin;
361 if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name");
362
363 *r = NULL;
364 while (entry) {
365 ierr = PetscStrcmp(name,entry->name,&flg);CHKERRQ(ierr);
366 if (flg) {
367 *r = entry->routine;
368 PetscFunctionReturn(0);
369 }
370 entry = entry->next;
371 }
372 PetscFunctionReturn(0);
373 }
374
375 /*@
376 PetscFunctionListView - prints out contents of an PetscFunctionList
377
378 Collective over MPI_Comm
379
380 Input Parameters:
381 + list - the list of functions
382 - viewer - currently ignored
383
384 Level: developer
385
386 .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
387 @*/
PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)388 PetscErrorCode PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
389 {
390 PetscErrorCode ierr;
391 PetscBool iascii;
392
393 PetscFunctionBegin;
394 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
395 PetscValidPointer(list,1);
396 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
397
398 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
399 if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported");
400
401 while (list) {
402 ierr = PetscViewerASCIIPrintf(viewer," %s\n",list->name);CHKERRQ(ierr);
403 list = list->next;
404 }
405 ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
406 PetscFunctionReturn(0);
407 }
408
409 /*@C
410 PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
411 by help etc.
412
413 Not Collective
414
415 Input Parameter:
416 . list - list of types
417
418 Output Parameter:
419 + array - array of names
420 - n - length of array
421
422 Notes:
423 This allocates the array so that must be freed. BUT the individual entries are
424 not copied so should not be freed.
425
426 Level: developer
427
428 .seealso: PetscFunctionListAdd(), PetscFunctionList
429 @*/
PetscFunctionListGet(PetscFunctionList list,const char *** array,int * n)430 PetscErrorCode PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
431 {
432 PetscErrorCode ierr;
433 PetscInt count = 0;
434 PetscFunctionList klist = list;
435
436 PetscFunctionBegin;
437 while (list) {
438 list = list->next;
439 count++;
440 }
441 ierr = PetscMalloc1(count+1,(char***)array);CHKERRQ(ierr);
442 count = 0;
443 while (klist) {
444 (*array)[count] = klist->name;
445 klist = klist->next;
446 count++;
447 }
448 (*array)[count] = NULL;
449 *n = count+1;
450 PetscFunctionReturn(0);
451 }
452
453
454 /*@C
455 PetscFunctionListPrintTypes - Prints the methods available.
456
457 Collective over MPI_Comm
458
459 Input Parameters:
460 + comm - the communicator (usually MPI_COMM_WORLD)
461 . fd - file to print to, usually stdout
462 . prefix - prefix to prepend to name (optional)
463 . name - option string (for example, "-ksp_type")
464 . text - short description of the object (for example, "Krylov solvers")
465 . man - name of manual page that discusses the object (for example, "KSPCreate")
466 . list - list of types
467 . def - default (current) value
468 - newv - new value
469
470 Level: developer
471
472 .seealso: PetscFunctionListAdd(), PetscFunctionList
473 @*/
PetscFunctionListPrintTypes(MPI_Comm comm,FILE * fd,const char prefix[],const char name[],const char text[],const char man[],PetscFunctionList list,const char def[],const char newv[])474 PetscErrorCode PetscFunctionListPrintTypes(MPI_Comm comm,FILE *fd,const char prefix[],const char name[],const char text[],const char man[],PetscFunctionList list,const char def[],const char newv[])
475 {
476 PetscErrorCode ierr;
477 char p[64];
478
479 PetscFunctionBegin;
480 if (!fd) fd = PETSC_STDOUT;
481
482 ierr = PetscStrncpy(p,"-",sizeof(p));CHKERRQ(ierr);
483 if (prefix) {ierr = PetscStrlcat(p,prefix,sizeof(p));CHKERRQ(ierr);}
484 ierr = PetscFPrintf(comm,fd," %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);CHKERRQ(ierr);
485
486 while (list) {
487 ierr = PetscFPrintf(comm,fd," %s",list->name);CHKERRQ(ierr);
488 list = list->next;
489 }
490 ierr = PetscFPrintf(comm,fd," (%s)\n",man);CHKERRQ(ierr);
491 PetscFunctionReturn(0);
492 }
493
494 /*@
495 PetscFunctionListDuplicate - Creates a new list from a given object list.
496
497 Input Parameters:
498 . fl - pointer to list
499
500 Output Parameters:
501 . nl - the new list (should point to 0 to start, otherwise appends)
502
503 Level: developer
504
505 .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy()
506
507 @*/
PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList * nl)508 PetscErrorCode PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
509 {
510 PetscErrorCode ierr;
511
512 PetscFunctionBegin;
513 while (fl) {
514 ierr = PetscFunctionListAdd(nl,fl->name,fl->routine);CHKERRQ(ierr);
515 fl = fl->next;
516 }
517 PetscFunctionReturn(0);
518 }
519