Actual source code: reg.c

petsc-3.14.6 2021-03-30
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
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: }