Date: 2021-03-03T22:25:40+00:00

Actual source code: reg.c
petsc-3.14.5 2021-03-03
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: }