Actual source code: str.c
petsc-3.10.5 2019-03-28
Report Typos and Errors

      2: /*
      3:     We define the string operations here. The reason we just do not use
      4:   the standard string routines in the PETSc code is that on some machines
      5:   they are broken or have the wrong prototypes.

      7: */
      8:  #include <petscsys.h>
      9: #if defined(PETSC_HAVE_STRING_H)
     10: #include <string.h>             /* strstr */
     11: #endif
     12: #if defined(PETSC_HAVE_STRINGS_H)
     13: #  include <strings.h>          /* strcasecmp */
     14: #endif

     16: /*@C
     17:    PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings

     19:    Not Collective

     21:    Input Parameters:
     22: +  s - pointer to string
     23: -  sp - separator charactor

     25:    Output Parameter:
     26: +   argc - the number of entries in the array
     27: -   args - an array of the entries with a null at the end

     29:    Level: intermediate

     31:    Notes:
     32:     this may be called before PetscInitialize() or after PetscFinalize()

     34:    Not for use in Fortran

     36:    Developer Notes:
     37:     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
     38:      to generate argc, args arguments passed to MPI_Init()

     40: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()

     42: @*/
     43: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
     44: {
     45:   int       i,j,n,*lens,cnt = 0;
     46:   PetscBool flg = PETSC_FALSE;

     48:   if (!s) n = 0;
     49:   else    n = strlen(s);
     50:   *argc = 0;
     51:   *args = NULL;
     52:   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
     53:     if (s[n-1] != sp) break;
     54:   }
     55:   if (!n) {
     56:     return(0);
     57:   }
     58:   for (i=0; i<n; i++) {
     59:     if (s[i] != sp) break;
     60:   }
     61:   for (;i<n+1; i++) {
     62:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     63:     else if (s[i] != sp) {flg = PETSC_FALSE;}
     64:   }
     65:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
     66:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
     67:   for (i=0; i<*argc; i++) lens[i] = 0;

     69:   *argc = 0;
     70:   for (i=0; i<n; i++) {
     71:     if (s[i] != sp) break;
     72:   }
     73:   for (;i<n+1; i++) {
     74:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     75:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
     76:   }

     78:   for (i=0; i<*argc; i++) {
     79:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
     80:     if (!(*args)[i]) {
     81:       free(lens);
     82:       for (j=0; j<i; j++) free((*args)[j]);
     83:       free(*args);
     84:       return PETSC_ERR_MEM;
     85:     }
     86:   }
     87:   free(lens);
     88:   (*args)[*argc] = 0;

     90:   *argc = 0;
     91:   for (i=0; i<n; i++) {
     92:     if (s[i] != sp) break;
     93:   }
     94:   for (;i<n+1; i++) {
     95:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
     96:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
     97:   }
     98:   return 0;
     99: }

    101: /*@C
    102:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

    104:    Not Collective

    106:    Output Parameters:
    107: +  argc - the number of arguments
    108: -  args - the array of arguments

    110:    Level: intermediate

    112:    Concepts: command line arguments

    114:    Notes:
    115:     This may be called before PetscInitialize() or after PetscFinalize()

    117:    Not for use in Fortran

    119: .seealso: PetscStrToArray()

    121: @*/
    122: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
    123: {
    124:   PetscInt i;

    126:   for (i=0; i<argc; i++) free(args[i]);
    127:   if (args) free(args);
    128:   return 0;
    129: }

    131: /*@C
    132:    PetscStrlen - Gets length of a string

    134:    Not Collective

    136:    Input Parameters:
    137: .  s - pointer to string

    139:    Output Parameter:
    140: .  len - length in bytes

    142:    Level: intermediate

    144:    Note:
    145:    This routine is analogous to strlen().

    147:    Null string returns a length of zero

    149:    Not for use in Fortran

    151:   Concepts: string length

    153: @*/
    154: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
    155: {
    157:   if (!s) *len = 0;
    158:   else    *len = strlen(s);
    159:   return(0);
    160: }

    162: /*@C
    163:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string

    165:    Not Collective

    167:    Input Parameters:
    168: .  s - pointer to string

    170:    Output Parameter:
    171: .  t - the copied string

    173:    Level: intermediate

    175:    Note:
    176:       Null string returns a new null string

    178:       Not for use in Fortran

    180:   Concepts: string copy

    182: @*/
    183: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
    184: {
    186:   size_t         len;
    187:   char           *tmp = 0;

    190:   if (s) {
    191:     PetscStrlen(s,&len);
    192:     PetscMalloc1(1+len,&tmp);
    193:     PetscStrcpy(tmp,s);
    194:   }
    195:   *t = tmp;
    196:   return(0);
    197: }

    199: /*@C
    200:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

    202:    Not Collective

    204:    Input Parameters:
    205: .  s - pointer to array of strings (final string is a null)

    207:    Output Parameter:
    208: .  t - the copied array string

    210:    Level: intermediate

    212:    Note:
    213:       Not for use in Fortran

    215:   Concepts: string copy

    217: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

    219: @*/
    220: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
    221: {
    223:   PetscInt       i,n = 0;

    226:   while (list[n++]) ;
    227:   PetscMalloc1(n+1,t);
    228:   for (i=0; i<n; i++) {
    229:     PetscStrallocpy(list[i],(*t)+i);
    230:   }
    231:   (*t)[n] = NULL;
    232:   return(0);
    233: }

    235: /*@C
    236:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

    238:    Not Collective

    240:    Output Parameters:
    241: .   list - array of strings

    243:    Level: intermediate

    245:    Concepts: command line arguments

    247:    Notes:
    248:     Not for use in Fortran

    250: .seealso: PetscStrArrayallocpy()

    252: @*/
    253: PetscErrorCode PetscStrArrayDestroy(char ***list)
    254: {
    255:   PetscInt       n = 0;

    259:   if (!*list) return(0);
    260:   while ((*list)[n]) {
    261:     PetscFree((*list)[n]);
    262:     n++;
    263:   }
    264:   PetscFree(*list);
    265:   return(0);
    266: }

    268: /*@C
    269:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

    271:    Not Collective

    273:    Input Parameters:
    274: +  n - the number of string entries
    275: -  s - pointer to array of strings

    277:    Output Parameter:
    278: .  t - the copied array string

    280:    Level: intermediate

    282:    Note:
    283:       Not for use in Fortran

    285:   Concepts: string copy

    287: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

    289: @*/
    290: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
    291: {
    293:   PetscInt       i;

    296:   PetscMalloc1(n,t);
    297:   for (i=0; i<n; i++) {
    298:     PetscStrallocpy(list[i],(*t)+i);
    299:   }
    300:   return(0);
    301: }

    303: /*@C
    304:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

    306:    Not Collective

    308:    Output Parameters:
    309: +   n - number of string entries
    310: -   list - array of strings

    312:    Level: intermediate

    314:    Notes:
    315:     Not for use in Fortran

    317: .seealso: PetscStrArrayallocpy()

    319: @*/
    320: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
    321: {
    323:   PetscInt       i;

    326:   if (!*list) return(0);
    327:   for (i=0; i<n; i++){
    328:     PetscFree((*list)[i]);
    329:   }
    330:   PetscFree(*list);
    331:   return(0);
    332: }

    334: /*@C
    335:    PetscStrcpy - Copies a string

    337:    Not Collective

    339:    Input Parameters:
    340: .  t - pointer to string

    342:    Output Parameter:
    343: .  s - the copied string

    345:    Level: intermediate

    347:    Notes:
    348:      Null string returns a string starting with zero

    350:      Not for use in Fortran

    352:   Concepts: string copy

    354: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()

    356: @*/

    358: PetscErrorCode  PetscStrcpy(char s[],const char t[])
    359: {
    361:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    362:   if (t) strcpy(s,t);
    363:   else if (s) s[0] = 0;
    364:   return(0);
    365: }

    367: /*@C
    368:    PetscStrncpy - Copies a string up to a certain length

    370:    Not Collective

    372:    Input Parameters:
    373: +  t - pointer to string
    374: -  n - the length to copy

    376:    Output Parameter:
    377: .  s - the copied string

    379:    Level: intermediate

    381:    Note:
    382:      Null string returns a string starting with zero

    384:      If the string that is being copied is of length n or larger then the entire string is not
    385:      copied and the final location of s is set to NULL. This is different then the behavior of
    386:      strncpy() which leaves s non-terminated if there is not room for the entire string.

    388:   Concepts: string copy

    390:   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()

    392: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()

    394: @*/
    395: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
    396: {
    398:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    399:   if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
    400:   if (t) {
    401:     if (n > 1) {
    402:       strncpy(s,t,n-1);
    403:       s[n-1] = '\0';
    404:     } else {
    405:       s[0] = '\0';
    406:     }
    407:   } else if (s) s[0] = 0;
    408:   return(0);
    409: }

    411: /*@C
    412:    PetscStrcat - Concatenates a string onto a given string

    414:    Not Collective

    416:    Input Parameters:
    417: +  s - string to be added to
    418: -  t - pointer to string to be added to end

    420:    Level: intermediate

    422:    Notes:
    423:     Not for use in Fortran

    425:   Concepts: string copy

    427: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()

    429: @*/
    430: PetscErrorCode  PetscStrcat(char s[],const char t[])
    431: {
    433:   if (!t) return(0);
    434:   strcat(s,t);
    435:   return(0);
    436: }

    438: /*@C
    439:    PetscStrlcat - Concatenates a string onto a given string, up to a given length

    441:    Not Collective

    443:    Input Parameters:
    444: +  s - pointer to string to be added to at end
    445: .  t - string to be added to
    446: -  n - length of the original allocated string

    448:    Level: intermediate

    450:   Notes:
    451:   Not for use in Fortran

    453:   Unlike the system call strncat(), the length passed in is the length of the
    454:   original allocated space, not the length of the left-over space. This is
    455:   similar to the BSD system call strlcat().

    457:   Concepts: string copy

    459: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()

    461: @*/
    462: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
    463: {
    464:   size_t         len;

    468:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
    469:   if (!t) return(0);
    470:   PetscStrlen(t,&len);
    471:   strncat(s,t,n - len);
    472:   s[n-1] = 0;
    473:   return(0);
    474: }

    476: /*

    479: */
    480: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
    481: {
    482:   int c;

    484:   if (!a && !b)      *flg = PETSC_TRUE;
    485:   else if (!a || !b) *flg = PETSC_FALSE;
    486:   else {
    487:     c = strcmp(a,b);
    488:     if (c) *flg = PETSC_FALSE;
    489:     else   *flg = PETSC_TRUE;
    490:   }
    491: }

    493: /*@C
    494:    PetscStrcmp - Compares two strings,

    496:    Not Collective

    498:    Input Parameters:
    499: +  a - pointer to string first string
    500: -  b - pointer to second string

    502:    Output Parameter:
    503: .  flg - PETSC_TRUE if the two strings are equal

    505:    Level: intermediate

    507:    Notes:
    508:     Not for use in Fortran

    510: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()

    512: @*/
    513: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
    514: {
    515:   int c;

    518:   if (!a && !b)      *flg = PETSC_TRUE;
    519:   else if (!a || !b) *flg = PETSC_FALSE;
    520:   else {
    521:     c = strcmp(a,b);
    522:     if (c) *flg = PETSC_FALSE;
    523:     else   *flg = PETSC_TRUE;
    524:   }
    525:   return(0);
    526: }

    528: /*@C
    529:    PetscStrgrt - If first string is greater than the second

    531:    Not Collective

    533:    Input Parameters:
    534: +  a - pointer to first string
    535: -  b - pointer to second string

    537:    Output Parameter:
    538: .  flg - if the first string is greater

    540:    Notes:
    541:     Null arguments are ok, a null string is considered smaller than
    542:     all others

    544:    Not for use in Fortran

    546:    Level: intermediate

    548: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()

    550: @*/
    551: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
    552: {
    553:   int c;

    556:   if (!a && !b) *t = PETSC_FALSE;
    557:   else if (a && !b) *t = PETSC_TRUE;
    558:   else if (!a && b) *t = PETSC_FALSE;
    559:   else {
    560:     c = strcmp(a,b);
    561:     if (c > 0) *t = PETSC_TRUE;
    562:     else       *t = PETSC_FALSE;
    563:   }
    564:   return(0);
    565: }

    567: /*@C
    568:    PetscStrcasecmp - Returns true if the two strings are the same
    569:      except possibly for case.

    571:    Not Collective

    573:    Input Parameters:
    574: +  a - pointer to first string
    575: -  b - pointer to second string

    577:    Output Parameter:
    578: .  flg - if the two strings are the same

    580:    Notes:
    581:     Null arguments are ok

    583:    Not for use in Fortran

    585:    Level: intermediate

    587: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()

    589: @*/
    590: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
    591: {
    592:   int c;

    595:   if (!a && !b) c = 0;
    596:   else if (!a || !b) c = 1;
    597: #if defined(PETSC_HAVE_STRCASECMP)
    598:   else c = strcasecmp(a,b);
    599: #elif defined(PETSC_HAVE_STRICMP)
    600:   else c = stricmp(a,b);
    601: #else
    602:   else {
    603:     char           *aa,*bb;
    605:     PetscStrallocpy(a,&aa);
    606:     PetscStrallocpy(b,&bb);
    607:     PetscStrtolower(aa);
    608:     PetscStrtolower(bb);
    609:     PetscStrcmp(aa,bb,t);
    610:     PetscFree(aa);
    611:     PetscFree(bb);
    612:     return(0);
    613:   }
    614: #endif
    615:   if (!c) *t = PETSC_TRUE;
    616:   else    *t = PETSC_FALSE;
    617:   return(0);
    618: }

    622: /*@C
    623:    PetscStrncmp - Compares two strings, up to a certain length

    625:    Not Collective

    627:    Input Parameters:
    628: +  a - pointer to first string
    629: .  b - pointer to second string
    630: -  n - length to compare up to

    632:    Output Parameter:
    633: .  t - if the two strings are equal

    635:    Level: intermediate

    637:    Notes:
    638:     Not for use in Fortran

    640: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()

    642: @*/
    643: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
    644: {
    645:   int c;

    648:   c = strncmp(a,b,n);
    649:   if (!c) *t = PETSC_TRUE;
    650:   else    *t = PETSC_FALSE;
    651:   return(0);
    652: }

    654: /*@C
    655:    PetscStrchr - Locates first occurance of a character in a string

    657:    Not Collective

    659:    Input Parameters:
    660: +  a - pointer to string
    661: -  b - character

    663:    Output Parameter:
    664: .  c - location of occurance, NULL if not found

    666:    Level: intermediate

    668:    Notes:
    669:     Not for use in Fortran

    671: @*/
    672: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
    673: {
    675:   *c = (char*)strchr(a,b);
    676:   return(0);
    677: }

    679: /*@C
    680:    PetscStrrchr - Locates one location past the last occurance of a character in a string,
    681:       if the character is not found then returns entire string

    683:    Not Collective

    685:    Input Parameters:
    686: +  a - pointer to string
    687: -  b - character

    689:    Output Parameter:
    690: .  tmp - location of occurance, a if not found

    692:    Level: intermediate

    694:    Notes:
    695:     Not for use in Fortran

    697: @*/
    698: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
    699: {
    701:   *tmp = (char*)strrchr(a,b);
    702:   if (!*tmp) *tmp = (char*)a;
    703:   else *tmp = *tmp + 1;
    704:   return(0);
    705: }

    707: /*@C
    708:    PetscStrtolower - Converts string to lower case

    710:    Not Collective

    712:    Input Parameters:
    713: .  a - pointer to string

    715:    Level: intermediate

    717:    Notes:
    718:     Not for use in Fortran

    720: @*/
    721: PetscErrorCode  PetscStrtolower(char a[])
    722: {
    724:   while (*a) {
    725:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
    726:     a++;
    727:   }
    728:   return(0);
    729: }

    731: /*@C
    732:    PetscStrtoupper - Converts string to upper case

    734:    Not Collective

    736:    Input Parameters:
    737: .  a - pointer to string

    739:    Level: intermediate

    741:    Notes:
    742:     Not for use in Fortran

    744: @*/
    745: PetscErrorCode  PetscStrtoupper(char a[])
    746: {
    748:   while (*a) {
    749:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
    750:     a++;
    751:   }
    752:   return(0);
    753: }

    755: /*@C
    756:    PetscStrendswith - Determines if a string ends with a certain string

    758:    Not Collective

    760:    Input Parameters:
    761: +  a - pointer to string
    762: -  b - string to endwith

    764:    Output Parameter:
    765: .  flg - PETSC_TRUE or PETSC_FALSE

    767:    Notes:
    768:     Not for use in Fortran

    770:    Level: intermediate

    772: @*/
    773: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
    774: {
    775:   char           *test;
    777:   size_t         na,nb;

    780:   *flg = PETSC_FALSE;
    781:   PetscStrrstr(a,b,&test);
    782:   if (test) {
    783:     PetscStrlen(a,&na);
    784:     PetscStrlen(b,&nb);
    785:     if (a+na-nb == test) *flg = PETSC_TRUE;
    786:   }
    787:   return(0);
    788: }

    790: /*@C
    791:    PetscStrbeginswith - Determines if a string begins with a certain string

    793:    Not Collective

    795:    Input Parameters:
    796: +  a - pointer to string
    797: -  b - string to begin with

    799:    Output Parameter:
    800: .  flg - PETSC_TRUE or PETSC_FALSE

    802:    Notes:
    803:     Not for use in Fortran

    805:    Level: intermediate

    807: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
    808:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

    810: @*/
    811: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
    812: {
    813:   char           *test;

    817:   *flg = PETSC_FALSE;
    818:   PetscStrrstr(a,b,&test);
    819:   if (test && (test == a)) *flg = PETSC_TRUE;
    820:   return(0);
    821: }

    824: /*@C
    825:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings

    827:    Not Collective

    829:    Input Parameters:
    830: +  a - pointer to string
    831: -  bs - strings to endwith (last entry must be null)

    833:    Output Parameter:
    834: .  cnt - the index of the string it ends with or 1+the last possible index

    836:    Notes:
    837:     Not for use in Fortran

    839:    Level: intermediate

    841: @*/
    842: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
    843: {
    844:   PetscBool      flg;

    848:   *cnt = 0;
    849:   while (bs[*cnt]) {
    850:     PetscStrendswith(a,bs[*cnt],&flg);
    851:     if (flg) return(0);
    852:     *cnt += 1;
    853:   }
    854:   return(0);
    855: }

    857: /*@C
    858:    PetscStrrstr - Locates last occurance of string in another string

    860:    Not Collective

    862:    Input Parameters:
    863: +  a - pointer to string
    864: -  b - string to find

    866:    Output Parameter:
    867: .  tmp - location of occurance

    869:    Notes:
    870:     Not for use in Fortran

    872:    Level: intermediate

    874: @*/
    875: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
    876: {
    877:   const char *stmp = a, *ltmp = 0;

    880:   while (stmp) {
    881:     stmp = (char*)strstr(stmp,b);
    882:     if (stmp) {ltmp = stmp;stmp++;}
    883:   }
    884:   *tmp = (char*)ltmp;
    885:   return(0);
    886: }

    888: /*@C
    889:    PetscStrstr - Locates first occurance of string in another string

    891:    Not Collective

    893:    Input Parameters:
    894: +  haystack - string to search
    895: -  needle - string to find

    897:    Output Parameter:
    898: .  tmp - location of occurance, is a NULL if the string is not found

    900:    Notes:
    901:     Not for use in Fortran

    903:    Level: intermediate

    905: @*/
    906: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
    907: {
    909:   *tmp = (char*)strstr(haystack,needle);
    910:   return(0);
    911: }

    913: struct _p_PetscToken {char token;char *array;char *current;};

    915: /*@C
    916:    PetscTokenFind - Locates next "token" in a string

    918:    Not Collective

    920:    Input Parameters:
    921: .  a - pointer to token

    923:    Output Parameter:
    924: .  result - location of occurance, NULL if not found

    926:    Notes:

    928:      This version is different from the system version in that
    929:   it allows you to pass a read-only string into the function.

    931:      This version also treats all characters etc. inside a double quote "
    932:    as a single token.

    934:      For example if the separator character is + and the string is xxxx+y then the first fine will return a pointer to a null terminated xxxx and the
    935:    second will return a null terminated y

    937:      If the separator character is + and the string is xxxx then the first and only token found will be a pointer to a null terminated xxxx

    939:     Not for use in Fortran

    941:    Level: intermediate

    944: .seealso: PetscTokenCreate(), PetscTokenDestroy()
    945: @*/
    946: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
    947: {
    948:   char *ptr = a->current,token;

    951:   *result = a->current;
    952:   if (ptr && !*ptr) {*result = 0;return(0);}
    953:   token = a->token;
    954:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
    955:   while (ptr) {
    956:     if (*ptr == token) {
    957:       *ptr++ = 0;
    958:       while (*ptr == a->token) ptr++;
    959:       a->current = ptr;
    960:       break;
    961:     }
    962:     if (!*ptr) {
    963:       a->current = 0;
    964:       break;
    965:     }
    966:     ptr++;
    967:   }
    968:   return(0);
    969: }

    971: /*@C
    972:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string

    974:    Not Collective

    976:    Input Parameters:
    977: +  string - the string to look in
    978: -  b - the separator character

    980:    Output Parameter:
    981: .  t- the token object

    983:    Notes:

    985:      This version is different from the system version in that
    986:   it allows you to pass a read-only string into the function.

    988:     Not for use in Fortran

    990:    Level: intermediate

    992: .seealso: PetscTokenFind(), PetscTokenDestroy()
    993: @*/
    994: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
    995: {

    999:   PetscNew(t);
    1000:   PetscStrallocpy(a,&(*t)->array);

    1002:   (*t)->current = (*t)->array;
    1003:   (*t)->token   = b;
    1004:   return(0);
    1005: }

    1007: /*@C
    1008:    PetscTokenDestroy - Destroys a PetscToken

    1010:    Not Collective

    1012:    Input Parameters:
    1013: .  a - pointer to token

    1015:    Level: intermediate

    1017:    Notes:
    1018:     Not for use in Fortran

    1020: .seealso: PetscTokenCreate(), PetscTokenFind()
    1021: @*/
    1022: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
    1023: {

    1027:   if (!*a) return(0);
    1028:   PetscFree((*a)->array);
    1029:   PetscFree(*a);
    1030:   return(0);
    1031: }

    1033: /*@C
    1034:    PetscStrInList - search string in character-delimited list

    1036:    Not Collective

    1038:    Input Parameters:
    1039: +  str - the string to look for
    1040: .  list - the list to search in
    1041: -  sep - the separator character

    1043:    Output Parameter:
    1044: .  found - whether str is in list

    1046:    Level: intermediate

    1048:    Notes:
    1049:     Not for use in Fortran

    1051: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
    1052: @*/
    1053: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
    1054: {
    1055:   PetscToken     token;
    1056:   char           *item;

    1060:   *found = PETSC_FALSE;
    1061:   PetscTokenCreate(list,sep,&token);
    1062:   PetscTokenFind(token,&item);
    1063:   while (item) {
    1064:     PetscStrcmp(str,item,found);
    1065:     if (*found) break;
    1066:     PetscTokenFind(token,&item);
    1067:   }
    1068:   PetscTokenDestroy(&token);
    1069:   return(0);
    1070: }

    1072: /*@C
    1073:    PetscGetPetscDir - Gets the directory PETSc is installed in

    1075:    Not Collective

    1077:    Output Parameter:
    1078: .  dir - the directory

    1080:    Level: developer

    1082:    Notes:
    1083:     Not for use in Fortran

    1085: @*/
    1086: PetscErrorCode  PetscGetPetscDir(const char *dir[])
    1087: {
    1089:   *dir = PETSC_DIR;
    1090:   return(0);
    1091: }

    1093: /*@C
    1094:    PetscStrreplace - Replaces substrings in string with other substrings

    1096:    Not Collective

    1098:    Input Parameters:
    1099: +   comm - MPI_Comm of processors that are processing the string
    1100: .   aa - the string to look in
    1101: .   b - the resulting copy of a with replaced strings (b can be the same as a)
    1102: -   len - the length of b

    1104:    Notes:
    1105:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
    1106:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
    1107:       as well as any environmental variables.

    1109:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
    1110:       PETSc was built with and do not use environmental variables.

    1112:       Not for use in Fortran

    1114:    Level: intermediate

    1116: @*/
    1117: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
    1118: {
    1120:   int            i = 0;
    1121:   size_t         l,l1,l2,l3;
    1122:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
    1123:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
    1124:   char           *r[] = {0,0,0,0,0,0,0,0,0};
    1125:   PetscBool      flag;

    1128:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
    1129:   if (aa == b) {
    1130:     PetscStrallocpy(aa,(char**)&a);
    1131:   }
    1132:   PetscMalloc1(len,&work);

    1134:   /* get values for replaced variables */
    1135:   PetscStrallocpy(PETSC_ARCH,&r[0]);
    1136:   PetscStrallocpy(PETSC_DIR,&r[1]);
    1137:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
    1138:   PetscMalloc1(256,&r[3]);
    1139:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
    1140:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
    1141:   PetscMalloc1(256,&r[6]);
    1142:   PetscMalloc1(256,&r[7]);
    1143:   PetscGetDisplay(r[3],256);
    1144:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
    1145:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
    1146:   PetscGetUserName(r[6],256);
    1147:   PetscGetHostName(r[7],256);

    1149:   /* replace that are in environment */
    1150:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
    1151:   if (flag) {
    1152:     PetscFree(r[2]);
    1153:     PetscStrallocpy(env,&r[2]);
    1154:   }

    1156:   /* replace the requested strings */
    1157:   PetscStrncpy(b,a,len);
    1158:   while (s[i]) {
    1159:     PetscStrlen(s[i],&l);
    1160:     PetscStrstr(b,s[i],&par);
    1161:     while (par) {
    1162:       *par =  0;
    1163:       par += l;

    1165:       PetscStrlen(b,&l1);
    1166:       PetscStrlen(r[i],&l2);
    1167:       PetscStrlen(par,&l3);
    1168:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
    1169:       PetscStrcpy(work,b);
    1170:       PetscStrcat(work,r[i]);
    1171:       PetscStrcat(work,par);
    1172:       PetscStrncpy(b,work,len);
    1173:       PetscStrstr(b,s[i],&par);
    1174:     }
    1175:     i++;
    1176:   }
    1177:   i = 0;
    1178:   while (r[i]) {
    1179:     tfree = (char*)r[i];
    1180:     PetscFree(tfree);
    1181:     i++;
    1182:   }

    1184:   /* look for any other ${xxx} strings to replace from environmental variables */
    1185:   PetscStrstr(b,"${",&par);
    1186:   while (par) {
    1187:     *par  = 0;
    1188:     par  += 2;
    1189:     PetscStrcpy(work,b);
    1190:     PetscStrstr(par,"}",&epar);
    1191:     *epar = 0;
    1192:     epar += 1;
    1193:     PetscOptionsGetenv(comm,par,env,256,&flag);
    1194:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
    1195:     PetscStrcat(work,env);
    1196:     PetscStrcat(work,epar);
    1197:     PetscStrcpy(b,work);
    1198:     PetscStrstr(b,"${",&par);
    1199:   }
    1200:   PetscFree(work);
    1201:   if (aa == b) {
    1202:     PetscFree(a);
    1203:   }
    1204:   return(0);
    1205: }

    1207: /*@C
    1208:    PetscEListFind - searches list of strings for given string, using case insensitive matching

    1210:    Not Collective

    1212:    Input Parameters:
    1213: +  n - number of strings in
    1214: .  list - list of strings to search
    1215: -  str - string to look for, empty string "" accepts default (first entry in list)

    1217:    Output Parameters:
    1218: +  value - index of matching string (if found)
    1219: -  found - boolean indicating whether string was found (can be NULL)

    1221:    Notes:
    1222:    Not for use in Fortran

    1224:    Level: advanced
    1225: @*/
    1226: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
    1227: {
    1229:   PetscBool matched;
    1230:   PetscInt i;

    1233:   if (found) *found = PETSC_FALSE;
    1234:   for (i=0; i<n; i++) {
    1235:     PetscStrcasecmp(str,list[i],&matched);
    1236:     if (matched || !str[0]) {
    1237:       if (found) *found = PETSC_TRUE;
    1238:       *value = i;
    1239:       break;
    1240:     }
    1241:   }
    1242:   return(0);
    1243: }

    1245: /*@C
    1246:    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching

    1248:    Not Collective

    1250:    Input Parameters:
    1251: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
    1252: -  str - string to look for

    1254:    Output Parameters:
    1255: +  value - index of matching string (if found)
    1256: -  found - boolean indicating whether string was found (can be NULL)

    1258:    Notes:
    1259:    Not for use in Fortran

    1261:    Level: advanced
    1262: @*/
    1263: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
    1264: {
    1266:   PetscInt n = 0,evalue;
    1267:   PetscBool efound;

    1270:   while (enumlist[n++]) if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
    1271:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
    1272:   n -= 3; /* drop enum name, prefix, and null termination */
    1273:   PetscEListFind(n,enumlist,str,&evalue,&efound);
    1274:   if (efound) *value = (PetscEnum)evalue;
    1275:   if (found) *found = efound;
    1276:   return(0);
    1277: }