Actual source code: reg.c
petsc-3.14.6 2021-03-30
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>
7: #include <petscviewer.h>
9: /*
10: This is the default list used by PETSc with the PetscDLLibrary register routines
11: */
12: PetscDLLibrary PetscDLLibrariesLoaded = NULL;
14: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
16: PetscErrorCode PetscLoadDynamicLibrary(const char *name,PetscBool *found)
17: {
18: char libs[PETSC_MAX_PATH_LEN],dlib[PETSC_MAX_PATH_LEN];
22: PetscStrncpy(libs,"${PETSC_LIB_DIR}/libpetsc",sizeof(libs));
23: PetscStrlcat(libs,name,sizeof(libs));
24: PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
25: if (*found) {
26: PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
27: } else {
28: PetscStrncpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc",sizeof(libs));
29: PetscStrlcat(libs,name,sizeof(libs));
30: PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
31: if (*found) {
32: PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
33: }
34: }
35: return(0);
36: }
37: #endif
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
56: /*
57: PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
58: search path.
59: */
60: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void)
61: {
62: char *libname[32];
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
73: nmax = 32;
74: PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);
75: for (i=0; i<nmax; i++) {
76: PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
77: PetscFree(libname[i]);
78: }
80: #if !defined(PETSC_USE_DYNAMIC_LIBRARIES) || !defined(PETSC_USE_SHARED_LIBRARIES)
81: /*
82: This just initializes the most basic PETSc stuff.
84: The classes, from PetscDraw to PetscTS, are initialized the first
85: time an XXCreate() is called.
86: */
87: PetscSysInitializePackage();
88: #else
89: preload = PETSC_FALSE;
90: PetscOptionsGetBool(NULL,NULL,"-dynamic_library_preload",&preload,NULL);
91: if (preload) {
92: PetscBool found;
93: #if defined(PETSC_USE_SINGLE_LIBRARY)
94: PetscLoadDynamicLibrary("",&found);
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: PetscLoadDynamicLibrary("sys",&found);
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: PetscLoadDynamicLibrary("vec",&found);
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: PetscLoadDynamicLibrary("mat",&found);
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: PetscLoadDynamicLibrary("dm",&found);
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: PetscLoadDynamicLibrary("ksp",&found);
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: PetscLoadDynamicLibrary("snes",&found);
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: PetscLoadDynamicLibrary("ts",&found);
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: PetscLoadDynamicLibrary("bamg",&found);
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
124: nmax = 32;
125: PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);
126: for (i=0; i<nmax; i++) {
127: PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
128: PetscFree(libname[i]);
129: }
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: AOInitializePackage();
134: PetscSFInitializePackage();
135: #if !defined(PETSC_USE_COMPLEX)
136: CharacteristicInitializePackage();
137: #endif
138: ISInitializePackage();
139: VecInitializePackage();
140: MatInitializePackage();
141: DMInitializePackage();
142: PCInitializePackage();
143: KSPInitializePackage();
144: SNESInitializePackage();
145: TSInitializePackage();
146: PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);
147: PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);
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: PetscElementalInitializePackage();
154: PetscInitializeCalled = PetscInitialized;
155: #endif
156: return(0);
157: }
159: /*
160: PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
161: */
162: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
163: {
165: PetscBool flg = PETSC_FALSE;
168: PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);
169: if (flg) { PetscDLLibraryPrintPath(PetscDLLibrariesLoaded); }
170: PetscDLLibraryClose(PetscDLLibrariesLoaded);
172: #if defined(PETSC_HAVE_THREADSAFETY)
173: PetscCommDestroy(&PETSC_COMM_SELF_INNER);
174: PetscCommDestroy(&PETSC_COMM_WORLD_INNER);
175: #endif
177: PetscDLLibrariesLoaded = NULL;
178: return(0);
179: }
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: };
191: /*
192: Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
193: */
194: static PetscFunctionList dlallhead = NULL;
196: /*MC
197: PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
198: specified registry.
200: Synopsis:
201: #include <petscsys.h>
202: PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void))
204: Not Collective
206: Input Parameters:
207: + flist - pointer to function list object
208: . name - string to identify routine
209: - fptr - function pointer
211: Notes:
212: To remove a registered routine, pass in a NULL fptr.
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.
219: Level: developer
221: .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
222: PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
223: M*/
224: PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
225: {
226: PetscFunctionList entry,ne;
227: PetscErrorCode ierr;
230: if (!*fl) {
231: PetscNew(&entry);
232: PetscStrallocpy(name,&entry->name);
233: entry->routine = fnc;
234: entry->next = NULL;
235: *fl = entry;
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: }
249: } else {
250: /* search list to see if it is already there */
251: ne = *fl;
252: while (ne) {
253: PetscBool founddup;
255: PetscStrcmp(ne->name,name,&founddup);
256: if (founddup) { /* found duplicate */
257: ne->routine = fnc;
258: return(0);
259: }
260: if (ne->next) ne = ne->next;
261: else break;
262: }
263: /* create new entry and add to end of list */
264: PetscNew(&entry);
265: PetscStrallocpy(name,&entry->name);
266: entry->routine = fnc;
267: entry->next = NULL;
268: ne->next = entry;
269: }
270: return(0);
271: }
273: /*@
274: PetscFunctionListDestroy - Destroys a list of registered routines.
276: Input Parameter:
277: . fl - pointer to list
279: Level: developer
281: .seealso: PetscFunctionListAdd(), PetscFunctionList
282: @*/
283: PetscErrorCode PetscFunctionListDestroy(PetscFunctionList *fl)
284: {
285: PetscFunctionList next,entry,tmp = dlallhead;
286: PetscErrorCode ierr;
289: if (!*fl) return(0);
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: }
305: /* free this list */
306: entry = *fl;
307: while (entry) {
308: next = entry->next;
309: PetscFree(entry->name);
310: PetscFree(entry);
311: entry = next;
312: }
313: *fl = NULL;
314: return(0);
315: }
317: /*
318: Print any PetscFunctionLists that have not be destroyed
319: */
320: PetscErrorCode PetscFunctionListPrintAll(void)
321: {
322: PetscFunctionList tmp = dlallhead;
323: PetscErrorCode ierr;
326: if (tmp) {
327: PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");
328: }
329: while (tmp) {
330: PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);
331: tmp = tmp->next_list;
332: }
333: return(0);
334: }
336: /*MC
337: PetscFunctionListFind - Find function registered under given name
339: Synopsis:
340: #include <petscsys.h>
341: PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void))
343: Input Parameters:
344: + flist - pointer to list
345: - name - name registered for the function
347: Output Parameters:
348: . fptr - the function pointer if name was found, else NULL
350: Level: developer
352: .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
353: M*/
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;
361: if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name");
363: *r = NULL;
364: while (entry) {
365: PetscStrcmp(name,entry->name,&flg);
366: if (flg) {
367: *r = entry->routine;
368: return(0);
369: }
370: entry = entry->next;
371: }
372: return(0);
373: }
375: /*@
376: PetscFunctionListView - prints out contents of an PetscFunctionList
378: Collective over MPI_Comm
380: Input Parameters:
381: + list - the list of functions
382: - viewer - currently ignored
384: Level: developer
386: .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
387: @*/
388: PetscErrorCode PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
389: {
391: PetscBool iascii;
394: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
398: PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
399: if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported");
401: while (list) {
402: PetscViewerASCIIPrintf(viewer," %s\n",list->name);
403: list = list->next;
404: }
405: PetscViewerASCIIPrintf(viewer,"\n");
406: return(0);
407: }
409: /*@C
410: PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
411: by help etc.
413: Not Collective
415: Input Parameter:
416: . list - list of types
418: Output Parameter:
419: + array - array of names
420: - n - length of array
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.
426: Level: developer
428: .seealso: PetscFunctionListAdd(), PetscFunctionList
429: @*/
430: PetscErrorCode PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
431: {
432: PetscErrorCode ierr;
433: PetscInt count = 0;
434: PetscFunctionList klist = list;
437: while (list) {
438: list = list->next;
439: count++;
440: }
441: PetscMalloc1(count+1,(char***)array);
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: return(0);
451: }
454: /*@C
455: PetscFunctionListPrintTypes - Prints the methods available.
457: Collective over MPI_Comm
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
470: Level: developer
472: .seealso: PetscFunctionListAdd(), PetscFunctionList
473: @*/
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: {
477: char p[64];
480: if (!fd) fd = PETSC_STDOUT;
482: PetscStrncpy(p,"-",sizeof(p));
483: if (prefix) {PetscStrlcat(p,prefix,sizeof(p));}
484: PetscFPrintf(comm,fd," %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);
486: while (list) {
487: PetscFPrintf(comm,fd," %s",list->name);
488: list = list->next;
489: }
490: PetscFPrintf(comm,fd," (%s)\n",man);
491: return(0);
492: }
494: /*@
495: PetscFunctionListDuplicate - Creates a new list from a given object list.
497: Input Parameters:
498: . fl - pointer to list
500: Output Parameters:
501: . nl - the new list (should point to 0 to start, otherwise appends)
503: Level: developer
505: .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy()
507: @*/
508: PetscErrorCode PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
509: {
513: while (fl) {
514: PetscFunctionListAdd(nl,fl->name,fl->routine);
515: fl = fl->next;
516: }
517: return(0);
518: }