Actual source code: reg.c

petsc-3.13.6 2020-09-29
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>
  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

115:   nmax = 32;
116:   PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);
117:   for (i=0; i<nmax; i++) {
118:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
119:     PetscFree(libname[i]);
120:   }

122: #if defined(PETSC_HAVE_THREADSAFETY)
123:   /* These must be done here because it is not safe for individual threads to call these initialize routines */
124:   AOInitializePackage();
125:   PetscSFInitializePackage();
126: #if !defined(PETSC_USE_COMPLEX)
127:   CharacteristicInitializePackage();
128: #endif
129:   ISInitializePackage();
130:   VecInitializePackage();
131:   MatInitializePackage();
132:   DMInitializePackage();
133:   PCInitializePackage();
134:   KSPInitializePackage();
135:   SNESInitializePackage();
136:   TSInitializePackage();
137:   PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);
138:   PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);
139: #endif
140: #if defined(PETSC_HAVE_ELEMENTAL)
141:   /* in Fortran, PetscInitializeCalled is set to PETSC_TRUE before PetscInitialize_DynamicLibraries() */
142:   /* in C, it is not the case, but the value is forced to PETSC_TRUE so that PetscRegisterFinalize() is called */
143:   PetscInitializeCalled = PETSC_TRUE;
144:   PetscElementalInitializePackage();
145:   PetscInitializeCalled = PetscInitialized;
146: #endif
147:   return(0);
148: }

150: /*
151:      PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
152: */
153: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
154: {
156:   PetscBool      flg = PETSC_FALSE;

159:   PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);
160:   if (flg) { PetscDLLibraryPrintPath(PetscDLLibrariesLoaded); }
161:   PetscDLLibraryClose(PetscDLLibrariesLoaded);

163: #if defined(PETSC_HAVE_THREADSAFETY)
164:   PetscCommDestroy(&PETSC_COMM_SELF_INNER);
165:   PetscCommDestroy(&PETSC_COMM_WORLD_INNER);
166: #endif

168:   PetscDLLibrariesLoaded = NULL;
169:   return(0);
170: }



174: /* ------------------------------------------------------------------------------*/
175: struct _n_PetscFunctionList {
176:   void              (*routine)(void);    /* the routine */
177:   char              *name;               /* string to identify routine */
178:   PetscFunctionList next;                /* next pointer */
179:   PetscFunctionList next_list;           /* used to maintain list of all lists for freeing */
180: };

182: /*
183:      Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
184: */
185: static PetscFunctionList dlallhead = NULL;

187: /*MC
188:    PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
189:    specified registry.

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

195:    Not Collective

197:    Input Parameters:
198: +  flist - pointer to function list object
199: .  name - string to identify routine
200: -  fptr - function pointer

202:    Notes:
203:    To remove a registered routine, pass in a NULL fptr.

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

210:     Level: developer

212: .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
213:           PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
214: M*/
215: PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
216: {
217:   PetscFunctionList entry,ne;
218:   PetscErrorCode    ierr;

221:   if (!*fl) {
222:     PetscNew(&entry);
223:     PetscStrallocpy(name,&entry->name);
224:     entry->routine = fnc;
225:     entry->next    = NULL;
226:     *fl            = entry;

228: #if defined(PETSC_USE_DEBUG)
229:     /* add this new list to list of all lists */
230:     if (!dlallhead) {
231:       dlallhead        = *fl;
232:       (*fl)->next_list = NULL;
233:     } else {
234:       ne               = dlallhead;
235:       dlallhead        = *fl;
236:       (*fl)->next_list = ne;
237:     }
238: #endif

240:   } else {
241:     /* search list to see if it is already there */
242:     ne = *fl;
243:     while (ne) {
244:       PetscBool founddup;

246:       PetscStrcmp(ne->name,name,&founddup);
247:       if (founddup) { /* found duplicate */
248:         ne->routine = fnc;
249:         return(0);
250:       }
251:       if (ne->next) ne = ne->next;
252:       else break;
253:     }
254:     /* create new entry and add to end of list */
255:     PetscNew(&entry);
256:     PetscStrallocpy(name,&entry->name);
257:     entry->routine = fnc;
258:     entry->next    = NULL;
259:     ne->next       = entry;
260:   }
261:   return(0);
262: }

264: /*@
265:     PetscFunctionListDestroy - Destroys a list of registered routines.

267:     Input Parameter:
268: .   fl  - pointer to list

270:     Level: developer

272: .seealso: PetscFunctionListAdd(), PetscFunctionList
273: @*/
274: PetscErrorCode  PetscFunctionListDestroy(PetscFunctionList *fl)
275: {
276:   PetscFunctionList next,entry,tmp = dlallhead;
277:   PetscErrorCode    ierr;

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

282:   /*
283:        Remove this entry from the master DL list (if it is in it)
284:   */
285:   if (dlallhead == *fl) {
286:     if (dlallhead->next_list) dlallhead = dlallhead->next_list;
287:     else dlallhead = NULL;
288:   } else if (tmp) {
289:     while (tmp->next_list != *fl) {
290:       tmp = tmp->next_list;
291:       if (!tmp->next_list) break;
292:     }
293:     if (tmp->next_list) tmp->next_list = tmp->next_list->next_list;
294:   }

296:   /* free this list */
297:   entry = *fl;
298:   while (entry) {
299:     next  = entry->next;
300:     PetscFree(entry->name);
301:     PetscFree(entry);
302:     entry = next;
303:   }
304:   *fl = NULL;
305:   return(0);
306: }

308: /*
309:    Print any PetscFunctionLists that have not be destroyed
310: */
311: PetscErrorCode  PetscFunctionListPrintAll(void)
312: {
313:   PetscFunctionList tmp = dlallhead;
314:   PetscErrorCode    ierr;

317:   if (tmp) {
318:     PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");
319:   }
320:   while (tmp) {
321:     PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);
322:     tmp = tmp->next_list;
323:   }
324:   return(0);
325: }

327: /*MC
328:     PetscFunctionListFind - Find function registered under given name

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

334:     Input Parameters:
335: +   flist   - pointer to list
336: -   name - name registered for the function

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

341:     Level: developer

343: .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
344: M*/
345: PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void))
346: {
347:   PetscFunctionList entry = fl;
348:   PetscErrorCode    ierr;
349:   PetscBool         flg;

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

354:   *r = NULL;
355:   while (entry) {
356:     PetscStrcmp(name,entry->name,&flg);
357:     if (flg) {
358:       *r   = entry->routine;
359:       return(0);
360:     }
361:     entry = entry->next;
362:   }
363:   return(0);
364: }

366: /*@
367:    PetscFunctionListView - prints out contents of an PetscFunctionList

369:    Collective over MPI_Comm

371:    Input Parameters:
372: +  list - the list of functions
373: -  viewer - currently ignored

375:    Level: developer

377: .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
378: @*/
379: PetscErrorCode  PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
380: {
382:   PetscBool      iascii;

385:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;

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

392:   while (list) {
393:     PetscViewerASCIIPrintf(viewer," %s\n",list->name);
394:     list = list->next;
395:   }
396:   PetscViewerASCIIPrintf(viewer,"\n");
397:   return(0);
398: }

400: /*@C
401:    PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
402:          by help etc.

404:    Not Collective

406:    Input Parameter:
407: .  list   - list of types

409:    Output Parameter:
410: +  array - array of names
411: -  n - length of array

413:    Notes:
414:        This allocates the array so that must be freed. BUT the individual entries are
415:     not copied so should not be freed.

417:    Level: developer

419: .seealso: PetscFunctionListAdd(), PetscFunctionList
420: @*/
421: PetscErrorCode  PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
422: {
423:   PetscErrorCode    ierr;
424:   PetscInt          count = 0;
425:   PetscFunctionList klist = list;

428:   while (list) {
429:     list = list->next;
430:     count++;
431:   }
432:   PetscMalloc1(count+1,(char***)array);
433:   count = 0;
434:   while (klist) {
435:     (*array)[count] = klist->name;
436:     klist           = klist->next;
437:     count++;
438:   }
439:   (*array)[count] = NULL;
440:   *n              = count+1;
441:   return(0);
442: }


445: /*@C
446:    PetscFunctionListPrintTypes - Prints the methods available.

448:    Collective over MPI_Comm

450:    Input Parameters:
451: +  comm   - the communicator (usually MPI_COMM_WORLD)
452: .  fd     - file to print to, usually stdout
453: .  prefix - prefix to prepend to name (optional)
454: .  name   - option string (for example, "-ksp_type")
455: .  text - short description of the object (for example, "Krylov solvers")
456: .  man - name of manual page that discusses the object (for example, "KSPCreate")
457: .  list   - list of types
458: .  def - default (current) value
459: -  newv - new value

461:    Level: developer

463: .seealso: PetscFunctionListAdd(), PetscFunctionList
464: @*/
465: 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[])
466: {
468:   char           p[64];

471:   if (!fd) fd = PETSC_STDOUT;

473:   PetscStrncpy(p,"-",sizeof(p));
474:   if (prefix) {PetscStrlcat(p,prefix,sizeof(p));}
475:   PetscFPrintf(comm,fd,"  %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);

477:   while (list) {
478:     PetscFPrintf(comm,fd," %s",list->name);
479:     list = list->next;
480:   }
481:   PetscFPrintf(comm,fd," (%s)\n",man);
482:   return(0);
483: }

485: /*@
486:     PetscFunctionListDuplicate - Creates a new list from a given object list.

488:     Input Parameters:
489: .   fl   - pointer to list

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

494:     Level: developer

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

498: @*/
499: PetscErrorCode  PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
500: {

504:   while (fl) {
505:     PetscFunctionListAdd(nl,fl->name,fl->routine);
506:     fl   = fl->next;
507:   }
508:   return(0);
509: }