Actual source code: reg.c
petsc-3.15.0 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: static 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_USE_SINGLE_LIBRARY) && !(defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES))
     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: PETSC_EXTERN PetscErrorCode TaoInitializePackage(void);
     54: #endif
     55: #if defined(PETSC_HAVE_THREADSAFETY)
     56: static MPI_Comm PETSC_COMM_WORLD_INNER = 0,PETSC_COMM_SELF_INNER = 0;
     57: #endif

     59: /*
     60:     PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
     61:     search path.
     62: */
     63: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void)
     64: {
     65:   char           *libname[32];
     67:   PetscInt       nmax,i;
     68:   PetscBool      preload = PETSC_FALSE;
     69: #if defined(PETSC_HAVE_ELEMENTAL)
     70:   PetscBool      PetscInitialized = PetscInitializeCalled;
     71: #endif

     74: #if defined(PETSC_HAVE_THREADSAFETY)
     75:   /* These must be all initialized here because it is not safe for individual threads to call these initialize routines */
     76:   preload = PETSC_TRUE;
     77: #endif

     79:   nmax = 32;
     80:   PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);
     81:   for (i=0; i<nmax; i++) {
     82:     PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
     83:     PetscFree(libname[i]);
     84:   }

     86:   PetscOptionsGetBool(NULL,NULL,"-library_preload",&preload,NULL);
     87:   if (!preload) {
     88:     PetscSysInitializePackage();
     89:   } else {
     90: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
     91:     PetscBool found;
     92: #if defined(PETSC_USE_SINGLE_LIBRARY)
     93:     PetscLoadDynamicLibrary("",&found);
     94:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
     95: #else
     96:     PetscLoadDynamicLibrary("sys",&found);
     97:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
     98:     PetscLoadDynamicLibrary("vec",&found);
     99:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!");
    100:     PetscLoadDynamicLibrary("mat",&found);
    101:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!");
    102:     PetscLoadDynamicLibrary("dm",&found);
    103:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!");
    104:     PetscLoadDynamicLibrary("ksp",&found);
    105:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!");
    106:     PetscLoadDynamicLibrary("snes",&found);
    107:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!");
    108:     PetscLoadDynamicLibrary("ts",&found);
    109:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!");
    110:     PetscLoadDynamicLibrary("tao",&found);
    111:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate Tao dynamic library \n You cannot move the dynamic libraries!");
    112: #endif
    113: #else /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */
    114: #if defined(PETSC_USE_SINGLE_LIBRARY)
    115:   AOInitializePackage();
    116:   PetscSFInitializePackage();
    117: #if !defined(PETSC_USE_COMPLEX)
    118:   CharacteristicInitializePackage();
    119: #endif
    120:   ISInitializePackage();
    121:   VecInitializePackage();
    122:   MatInitializePackage();
    123:   DMInitializePackage();
    124:   PCInitializePackage();
    125:   KSPInitializePackage();
    126:   SNESInitializePackage();
    127:   TSInitializePackage();
    128:   TaoInitializePackage();
    129: #else
    130:   SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Cannot use -library_preload with multiple static PETSc libraries");
    131: #endif
    132: #endif /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */
    133:   }

    135: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) && defined(PETSC_HAVE_BAMG)
    136:   {
    137:     PetscBool found;
    138:     PetscLoadDynamicLibrary("bamg",&found);
    139:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc BAMG dynamic library \n You cannot move the dynamic libraries!");
    140:   }
    141: #endif

    143:   nmax = 32;
    144:   PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);
    145:   for (i=0; i<nmax; i++) {
    146:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
    147:     PetscFree(libname[i]);
    148:   }

    150: #if defined(PETSC_HAVE_THREADSAFETY)
    151:   PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);
    152:   PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);
    153: #endif
    154: #if defined(PETSC_HAVE_ELEMENTAL)
    155:   /* in Fortran, PetscInitializeCalled is set to PETSC_TRUE before PetscInitialize_DynamicLibraries() */
    156:   /* in C, it is not the case, but the value is forced to PETSC_TRUE so that PetscRegisterFinalize() is called */
    157:   PetscInitializeCalled = PETSC_TRUE;
    158:   PetscElementalInitializePackage();
    159:   PetscInitializeCalled = PetscInitialized;
    160: #endif
    161:   return(0);
    162: }

    164: /*
    165:      PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
    166: */
    167: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
    168: {
    170:   PetscBool      flg = PETSC_FALSE;

    173:   PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);
    174:   if (flg) { PetscDLLibraryPrintPath(PetscDLLibrariesLoaded); }
    175:   PetscDLLibraryClose(PetscDLLibrariesLoaded);

    177: #if defined(PETSC_HAVE_THREADSAFETY)
    178:   PetscCommDestroy(&PETSC_COMM_SELF_INNER);
    179:   PetscCommDestroy(&PETSC_COMM_WORLD_INNER);
    180: #endif

    182:   PetscDLLibrariesLoaded = NULL;
    183:   return(0);
    184: }

    188: /* ------------------------------------------------------------------------------*/
    189: struct _n_PetscFunctionList {
    190:   void              (*routine)(void);    /* the routine */
    191:   char              *name;               /* string to identify routine */
    192:   PetscFunctionList next;                /* next pointer */
    193:   PetscFunctionList next_list;           /* used to maintain list of all lists for freeing */
    194: };

    196: /*
    197:      Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
    198: */
    199: static PetscFunctionList dlallhead = NULL;

    201: /*MC
    202:    PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
    203:    specified registry.

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

    209:    Not Collective

    211:    Input Parameters:
    212: +  flist - pointer to function list object
    213: .  name - string to identify routine
    214: -  fptr - function pointer

    216:    Notes:
    217:    To remove a registered routine, pass in a NULL fptr.

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

    224:     Level: developer

    226: .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
    227:           PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
    228: M*/
    229: PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
    230: {
    231:   PetscFunctionList entry,ne;
    232:   PetscErrorCode    ierr;

    235:   if (!*fl) {
    236:     PetscNew(&entry);
    237:     PetscStrallocpy(name,&entry->name);
    238:     entry->routine = fnc;
    239:     entry->next    = NULL;
    240:     *fl            = entry;

    242:     if (PetscDefined(USE_DEBUG)) {
    243:       /* add this new list to list of all lists */
    244:       if (!dlallhead) {
    245:         dlallhead        = *fl;
    246:         (*fl)->next_list = NULL;
    247:       } else {
    248:         ne               = dlallhead;
    249:         dlallhead        = *fl;
    250:         (*fl)->next_list = ne;
    251:       }
    252:     }

    254:   } else {
    255:     /* search list to see if it is already there */
    256:     ne = *fl;
    257:     while (ne) {
    258:       PetscBool founddup;

    260:       PetscStrcmp(ne->name,name,&founddup);
    261:       if (founddup) { /* found duplicate */
    262:         ne->routine = fnc;
    263:         return(0);
    264:       }
    265:       if (ne->next) ne = ne->next;
    266:       else break;
    267:     }
    268:     /* create new entry and add to end of list */
    269:     PetscNew(&entry);
    270:     PetscStrallocpy(name,&entry->name);
    271:     entry->routine = fnc;
    272:     entry->next    = NULL;
    273:     ne->next       = entry;
    274:   }
    275:   return(0);
    276: }

    278: /*@
    279:     PetscFunctionListDestroy - Destroys a list of registered routines.

    281:     Input Parameter:
    282: .   fl  - pointer to list

    284:     Level: developer

    286: .seealso: PetscFunctionListAdd(), PetscFunctionList
    287: @*/
    288: PetscErrorCode  PetscFunctionListDestroy(PetscFunctionList *fl)
    289: {
    290:   PetscFunctionList next,entry,tmp = dlallhead;
    291:   PetscErrorCode    ierr;

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

    296:   /*
    297:        Remove this entry from the main DL list (if it is in it)
    298:   */
    299:   if (dlallhead == *fl) {
    300:     if (dlallhead->next_list) dlallhead = dlallhead->next_list;
    301:     else dlallhead = NULL;
    302:   } else if (tmp) {
    303:     while (tmp->next_list != *fl) {
    304:       tmp = tmp->next_list;
    305:       if (!tmp->next_list) break;
    306:     }
    307:     if (tmp->next_list) tmp->next_list = tmp->next_list->next_list;
    308:   }

    310:   /* free this list */
    311:   entry = *fl;
    312:   while (entry) {
    313:     next  = entry->next;
    314:     PetscFree(entry->name);
    315:     PetscFree(entry);
    316:     entry = next;
    317:   }
    318:   *fl = NULL;
    319:   return(0);
    320: }

    322: /*
    323:    Print any PetscFunctionLists that have not be destroyed
    324: */
    325: PetscErrorCode  PetscFunctionListPrintAll(void)
    326: {
    327:   PetscFunctionList tmp = dlallhead;
    328:   PetscErrorCode    ierr;

    331:   if (tmp) {
    332:     PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");
    333:   }
    334:   while (tmp) {
    335:     PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);
    336:     tmp = tmp->next_list;
    337:   }
    338:   return(0);
    339: }

    341: /*MC
    342:     PetscFunctionListFind - Find function registered under given name

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

    348:     Input Parameters:
    349: +   flist   - pointer to list
    350: -   name - name registered for the function

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

    355:     Level: developer

    357: .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
    358: M*/
    359: PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void))
    360: {
    361:   PetscFunctionList entry = fl;
    362:   PetscErrorCode    ierr;
    363:   PetscBool         flg;

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

    368:   *r = NULL;
    369:   while (entry) {
    370:     PetscStrcmp(name,entry->name,&flg);
    371:     if (flg) {
    372:       *r   = entry->routine;
    373:       return(0);
    374:     }
    375:     entry = entry->next;
    376:   }
    377:   return(0);
    378: }

    380: /*@
    381:    PetscFunctionListView - prints out contents of an PetscFunctionList

    383:    Collective over MPI_Comm

    385:    Input Parameters:
    386: +  list - the list of functions
    387: -  viewer - currently ignored

    389:    Level: developer

    391: .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
    392: @*/
    393: PetscErrorCode  PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
    394: {
    396:   PetscBool      iascii;

    399:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;

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

    406:   while (list) {
    407:     PetscViewerASCIIPrintf(viewer," %s\n",list->name);
    408:     list = list->next;
    409:   }
    410:   PetscViewerASCIIPrintf(viewer,"\n");
    411:   return(0);
    412: }

    414: /*@C
    415:    PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
    416:          by help etc.

    418:    Not Collective

    420:    Input Parameter:
    421: .  list   - list of types

    423:    Output Parameter:
    424: +  array - array of names
    425: -  n - length of array

    427:    Notes:
    428:        This allocates the array so that must be freed. BUT the individual entries are
    429:     not copied so should not be freed.

    431:    Level: developer

    433: .seealso: PetscFunctionListAdd(), PetscFunctionList
    434: @*/
    435: PetscErrorCode  PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
    436: {
    437:   PetscErrorCode    ierr;
    438:   PetscInt          count = 0;
    439:   PetscFunctionList klist = list;

    442:   while (list) {
    443:     list = list->next;
    444:     count++;
    445:   }
    446:   PetscMalloc1(count+1,(char***)array);
    447:   count = 0;
    448:   while (klist) {
    449:     (*array)[count] = klist->name;
    450:     klist           = klist->next;
    451:     count++;
    452:   }
    453:   (*array)[count] = NULL;
    454:   *n              = count+1;
    455:   return(0);
    456: }

    459: /*@C
    460:    PetscFunctionListPrintTypes - Prints the methods available.

    462:    Collective over MPI_Comm

    464:    Input Parameters:
    465: +  comm   - the communicator (usually MPI_COMM_WORLD)
    466: .  fd     - file to print to, usually stdout
    467: .  prefix - prefix to prepend to name (optional)
    468: .  name   - option string (for example, "-ksp_type")
    469: .  text - short description of the object (for example, "Krylov solvers")
    470: .  man - name of manual page that discusses the object (for example, "KSPCreate")
    471: .  list   - list of types
    472: .  def - default (current) value
    473: -  newv - new value

    475:    Level: developer

    477: .seealso: PetscFunctionListAdd(), PetscFunctionList
    478: @*/
    479: 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[])
    480: {
    482:   char           p[64];

    485:   if (!fd) fd = PETSC_STDOUT;

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

    491:   while (list) {
    492:     PetscFPrintf(comm,fd," %s",list->name);
    493:     list = list->next;
    494:   }
    495:   PetscFPrintf(comm,fd," (%s)\n",man);
    496:   return(0);
    497: }

    499: /*@
    500:     PetscFunctionListDuplicate - Creates a new list from a given object list.

    502:     Input Parameters:
    503: .   fl   - pointer to list

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

    508:     Level: developer

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

    512: @*/
    513: PetscErrorCode  PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
    514: {

    518:   while (fl) {
    519:     PetscFunctionListAdd(nl,fl->name,fl->routine);
    520:     fl   = fl->next;
    521:   }
    522:   return(0);
    523: }