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