Actual source code: str.c
petsc-3.7.1 2016-05-15
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>                   /*I  "petscsys.h"   I*/
      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

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

     21:    Not Collective

     23:    Input Parameters:
     24: +  s - pointer to string
     25: -  sp - separator charactor

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

     31:    Level: intermediate

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

     35:    Not for use in Fortran

     37:    Developer Notes: 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:   if (!n) {
     53:     return(0);
     54:   }
     55:   for (i=0; i<n; i++) {
     56:     if (s[i] != sp) break;
     57:   }
     58:   for (;i<n+1; i++) {
     59:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     60:     else if (s[i] != sp) {flg = PETSC_FALSE;}
     61:   }
     62:   if (!*argc) { /* string only has separator characters */
     63:     return(0);
     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: }

    103: /*@C
    104:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

    106:    Not Collective

    108:    Output Parameters:
    109: +  argc - the number of arguments
    110: -  args - the array of arguments

    112:    Level: intermediate

    114:    Concepts: command line arguments

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

    118:    Not for use in Fortran

    120: .seealso: PetscStrToArray()

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

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

    134: /*@C
    135:    PetscStrlen - Gets length of a string

    137:    Not Collective

    139:    Input Parameters:
    140: .  s - pointer to string

    142:    Output Parameter:
    143: .  len - length in bytes

    145:    Level: intermediate

    147:    Note:
    148:    This routine is analogous to strlen().

    150:    Null string returns a length of zero

    152:    Not for use in Fortran

    154:   Concepts: string length

    156: @*/
    157: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
    158: {
    160:   if (!s) *len = 0;
    161:   else    *len = strlen(s);
    162:   return(0);
    163: }

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

    170:    Not Collective

    172:    Input Parameters:
    173: .  s - pointer to string

    175:    Output Parameter:
    176: .  t - the copied string

    178:    Level: intermediate

    180:    Note:
    181:       Null string returns a new null string

    183:       Not for use in Fortran

    185:   Concepts: string copy

    187: @*/
    188: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
    189: {
    191:   size_t         len;
    192:   char           *tmp = 0;

    195:   if (s) {
    196:     PetscStrlen(s,&len);
    197:     PetscMalloc1(1+len,&tmp);
    198:     PetscStrcpy(tmp,s);
    199:   }
    200:   *t = tmp;
    201:   return(0);
    202: }

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

    209:    Not Collective

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

    214:    Output Parameter:
    215: .  t - the copied array string

    217:    Level: intermediate

    219:    Note:
    220:       Not for use in Fortran

    222:   Concepts: string copy

    224: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

    226: @*/
    227: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
    228: {
    230:   PetscInt       i,n = 0;

    233:   while (list[n++]) ;
    234:   PetscMalloc1(n+1,t);
    235:   for (i=0; i<n; i++) {
    236:     PetscStrallocpy(list[i],(*t)+i);
    237:   }
    238:   (*t)[n] = NULL;
    239:   return(0);
    240: }

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

    247:    Not Collective

    249:    Output Parameters:
    250: .   list - array of strings

    252:    Level: intermediate

    254:    Concepts: command line arguments

    256:    Notes: Not for use in Fortran

    258: .seealso: PetscStrArrayallocpy()

    260: @*/
    261: PetscErrorCode PetscStrArrayDestroy(char ***list)
    262: {
    263:   PetscInt       n = 0;

    267:   if (!*list) return(0);
    268:   while ((*list)[n]) {
    269:     PetscFree((*list)[n]);
    270:     n++;
    271:   }
    272:   PetscFree(*list);
    273:   return(0);
    274: }

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

    281:    Not Collective

    283:    Input Parameters:
    284: +  n - the number of string entries
    285: -  s - pointer to array of strings

    287:    Output Parameter:
    288: .  t - the copied array string

    290:    Level: intermediate

    292:    Note:
    293:       Not for use in Fortran

    295:   Concepts: string copy

    297: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

    299: @*/
    300: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
    301: {
    303:   PetscInt       i;

    306:   PetscMalloc1(n,t);
    307:   for (i=0; i<n; i++) {
    308:     PetscStrallocpy(list[i],(*t)+i);
    309:   }
    310:   return(0);
    311: }

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

    318:    Not Collective

    320:    Output Parameters:
    321: +   n - number of string entries
    322: -   list - array of strings

    324:    Level: intermediate

    326:    Notes: Not for use in Fortran

    328: .seealso: PetscStrArrayallocpy()

    330: @*/
    331: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
    332: {
    334:   PetscInt       i;

    337:   if (!*list) return(0);
    338:   for (i=0; i<n; i++){
    339:     PetscFree((*list)[i]);
    340:   }
    341:   PetscFree(*list);
    342:   return(0);
    343: }

    347: /*@C
    348:    PetscStrcpy - Copies a string

    350:    Not Collective

    352:    Input Parameters:
    353: .  t - pointer to string

    355:    Output Parameter:
    356: .  s - the copied string

    358:    Level: intermediate

    360:    Notes:
    361:      Null string returns a string starting with zero

    363:      Not for use in Fortran

    365:   Concepts: string copy

    367: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()

    369: @*/

    371: PetscErrorCode  PetscStrcpy(char s[],const char t[])
    372: {
    374:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    375:   if (t) strcpy(s,t);
    376:   else if (s) s[0] = 0;
    377:   return(0);
    378: }

    382: /*@C
    383:    PetscStrncpy - Copies a string up to a certain length

    385:    Not Collective

    387:    Input Parameters:
    388: +  t - pointer to string
    389: -  n - the length to copy

    391:    Output Parameter:
    392: .  s - the copied string

    394:    Level: intermediate

    396:    Note:
    397:      Null string returns a string starting with zero

    399:      If the string that is being copied is of length n or larger then the entire string is not
    400:      copied and the file location of s is set to NULL. This is different then the behavior of
    401:      strncpy() which leaves s non-terminated.

    403:   Concepts: string copy

    405: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()

    407: @*/
    408: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
    409: {
    411:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    412:   if (t) {
    413:     if (n > 1) {
    414:       strncpy(s,t,n-1);
    415:       s[n-1] = '\0';
    416:     } else {
    417:       s[0] = '\0';
    418:     }
    419:   } else if (s) s[0] = 0;
    420:   return(0);
    421: }

    425: /*@C
    426:    PetscStrcat - Concatenates a string onto a given string

    428:    Not Collective

    430:    Input Parameters:
    431: +  s - string to be added to
    432: -  t - pointer to string to be added to end

    434:    Level: intermediate

    436:    Notes: Not for use in Fortran

    438:   Concepts: string copy

    440: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()

    442: @*/
    443: PetscErrorCode  PetscStrcat(char s[],const char t[])
    444: {
    446:   if (!t) return(0);
    447:   strcat(s,t);
    448:   return(0);
    449: }

    453: /*@C
    454:    PetscStrncat - Concatenates a string onto a given string, up to a given length

    456:    Not Collective

    458:    Input Parameters:
    459: +  s - pointer to string to be added to end
    460: .  t - string to be added to
    461: .  n - maximum length to copy

    463:    Level: intermediate

    465:   Notes:    Not for use in Fortran

    467:   Concepts: string copy

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

    471: @*/
    472: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
    473: {
    475:   strncat(s,t,n);
    476:   return(0);
    477: }

    481: /*

    484:    Will be removed once we eliminate the __FUNCT__ paradigm
    485: */
    486: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
    487: {
    488:   int c;

    490:   if (!a && !b)      *flg = PETSC_TRUE;
    491:   else if (!a || !b) *flg = PETSC_FALSE;
    492:   else {
    493:     c = strcmp(a,b);
    494:     if (c) *flg = PETSC_FALSE;
    495:     else   *flg = PETSC_TRUE;
    496:   }
    497: }

    501: /*@C
    502:    PetscStrcmp - Compares two strings,

    504:    Not Collective

    506:    Input Parameters:
    507: +  a - pointer to string first string
    508: -  b - pointer to second string

    510:    Output Parameter:
    511: .  flg - PETSC_TRUE if the two strings are equal

    513:    Level: intermediate

    515:    Notes:    Not for use in Fortran

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

    519: @*/
    520: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
    521: {
    522:   int c;

    525:   if (!a && !b)      *flg = PETSC_TRUE;
    526:   else if (!a || !b) *flg = PETSC_FALSE;
    527:   else {
    528:     c = strcmp(a,b);
    529:     if (c) *flg = PETSC_FALSE;
    530:     else   *flg = PETSC_TRUE;
    531:   }
    532:   return(0);
    533: }

    537: /*@C
    538:    PetscStrgrt - If first string is greater than the second

    540:    Not Collective

    542:    Input Parameters:
    543: +  a - pointer to first string
    544: -  b - pointer to second string

    546:    Output Parameter:
    547: .  flg - if the first string is greater

    549:    Notes:
    550:     Null arguments are ok, a null string is considered smaller than
    551:     all others

    553:    Not for use in Fortran

    555:    Level: intermediate

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

    559: @*/
    560: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
    561: {
    562:   int c;

    565:   if (!a && !b) *t = PETSC_FALSE;
    566:   else if (a && !b) *t = PETSC_TRUE;
    567:   else if (!a && b) *t = PETSC_FALSE;
    568:   else {
    569:     c = strcmp(a,b);
    570:     if (c > 0) *t = PETSC_TRUE;
    571:     else       *t = PETSC_FALSE;
    572:   }
    573:   return(0);
    574: }

    578: /*@C
    579:    PetscStrcasecmp - Returns true if the two strings are the same
    580:      except possibly for case.

    582:    Not Collective

    584:    Input Parameters:
    585: +  a - pointer to first string
    586: -  b - pointer to second string

    588:    Output Parameter:
    589: .  flg - if the two strings are the same

    591:    Notes:
    592:     Null arguments are ok

    594:    Not for use in Fortran

    596:    Level: intermediate

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

    600: @*/
    601: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
    602: {
    603:   int c;

    606:   if (!a && !b) c = 0;
    607:   else if (!a || !b) c = 1;
    608: #if defined(PETSC_HAVE_STRCASECMP)
    609:   else c = strcasecmp(a,b);
    610: #elif defined(PETSC_HAVE_STRICMP)
    611:   else c = stricmp(a,b);
    612: #else
    613:   else {
    614:     char           *aa,*bb;
    616:     PetscStrallocpy(a,&aa);
    617:     PetscStrallocpy(b,&bb);
    618:     PetscStrtolower(aa);
    619:     PetscStrtolower(bb);
    620:     PetscStrcmp(aa,bb,t);
    621:     PetscFree(aa);
    622:     PetscFree(bb);
    623:     return(0);
    624:   }
    625: #endif
    626:   if (!c) *t = PETSC_TRUE;
    627:   else    *t = PETSC_FALSE;
    628:   return(0);
    629: }

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

    638:    Not Collective

    640:    Input Parameters:
    641: +  a - pointer to first string
    642: .  b - pointer to second string
    643: -  n - length to compare up to

    645:    Output Parameter:
    646: .  t - if the two strings are equal

    648:    Level: intermediate

    650:    Notes:    Not for use in Fortran

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

    654: @*/
    655: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
    656: {
    657:   int c;

    660:   c = strncmp(a,b,n);
    661:   if (!c) *t = PETSC_TRUE;
    662:   else    *t = PETSC_FALSE;
    663:   return(0);
    664: }

    668: /*@C
    669:    PetscStrchr - Locates first occurance of a character in a string

    671:    Not Collective

    673:    Input Parameters:
    674: +  a - pointer to string
    675: -  b - character

    677:    Output Parameter:
    678: .  c - location of occurance, NULL if not found

    680:    Level: intermediate

    682:    Notes:    Not for use in Fortran

    684: @*/
    685: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
    686: {
    688:   *c = (char*)strchr(a,b);
    689:   return(0);
    690: }

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

    698:    Not Collective

    700:    Input Parameters:
    701: +  a - pointer to string
    702: -  b - character

    704:    Output Parameter:
    705: .  tmp - location of occurance, a if not found

    707:    Level: intermediate

    709:    Notes:    Not for use in Fortran

    711: @*/
    712: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
    713: {
    715:   *tmp = (char*)strrchr(a,b);
    716:   if (!*tmp) *tmp = (char*)a;
    717:   else *tmp = *tmp + 1;
    718:   return(0);
    719: }

    723: /*@C
    724:    PetscStrtolower - Converts string to lower case

    726:    Not Collective

    728:    Input Parameters:
    729: .  a - pointer to string

    731:    Level: intermediate

    733:    Notes:    Not for use in Fortran

    735: @*/
    736: PetscErrorCode  PetscStrtolower(char a[])
    737: {
    739:   while (*a) {
    740:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
    741:     a++;
    742:   }
    743:   return(0);
    744: }

    748: /*@C
    749:    PetscStrtolower - Converts string to upper case

    751:    Not Collective

    753:    Input Parameters:
    754: .  a - pointer to string

    756:    Level: intermediate

    758:    Notes:    Not for use in Fortran

    760: @*/
    761: PetscErrorCode  PetscStrtoupper(char a[])
    762: {
    764:   while (*a) {
    765:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
    766:     a++;
    767:   }
    768:   return(0);
    769: }

    773: /*@C
    774:    PetscStrendswith - Determines if a string ends with a certain string

    776:    Not Collective

    778:    Input Parameters:
    779: +  a - pointer to string
    780: -  b - string to endwith

    782:    Output Parameter:
    783: .  flg - PETSC_TRUE or PETSC_FALSE

    785:    Notes:     Not for use in Fortran

    787:    Level: intermediate

    789: @*/
    790: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
    791: {
    792:   char           *test;
    794:   size_t         na,nb;

    797:   *flg = PETSC_FALSE;
    798:   PetscStrrstr(a,b,&test);
    799:   if (test) {
    800:     PetscStrlen(a,&na);
    801:     PetscStrlen(b,&nb);
    802:     if (a+na-nb == test) *flg = PETSC_TRUE;
    803:   }
    804:   return(0);
    805: }

    809: /*@C
    810:    PetscStrbeginswith - Determines if a string begins with a certain string

    812:    Not Collective

    814:    Input Parameters:
    815: +  a - pointer to string
    816: -  b - string to beginwith

    818:    Output Parameter:
    819: .  flg - PETSC_TRUE or PETSC_FALSE

    821:    Notes:     Not for use in Fortran

    823:    Level: intermediate

    825: @*/
    826: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
    827: {
    828:   char           *test;

    832:   *flg = PETSC_FALSE;
    833:   PetscStrrstr(a,b,&test);
    834:   if (test && (test == a)) *flg = PETSC_TRUE;
    835:   return(0);
    836: }

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

    844:    Not Collective

    846:    Input Parameters:
    847: +  a - pointer to string
    848: -  bs - strings to endwith (last entry must be null)

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

    853:    Notes:     Not for use in Fortran

    855:    Level: intermediate

    857: @*/
    858: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
    859: {
    860:   PetscBool      flg;

    864:   *cnt = 0;
    865:   while (bs[*cnt]) {
    866:     PetscStrendswith(a,bs[*cnt],&flg);
    867:     if (flg) return(0);
    868:     *cnt += 1;
    869:   }
    870:   return(0);
    871: }

    875: /*@C
    876:    PetscStrrstr - Locates last occurance of string in another string

    878:    Not Collective

    880:    Input Parameters:
    881: +  a - pointer to string
    882: -  b - string to find

    884:    Output Parameter:
    885: .  tmp - location of occurance

    887:    Notes:     Not for use in Fortran

    889:    Level: intermediate

    891: @*/
    892: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
    893: {
    894:   const char *stmp = a, *ltmp = 0;

    897:   while (stmp) {
    898:     stmp = (char*)strstr(stmp,b);
    899:     if (stmp) {ltmp = stmp;stmp++;}
    900:   }
    901:   *tmp = (char*)ltmp;
    902:   return(0);
    903: }

    907: /*@C
    908:    PetscStrstr - Locates first occurance of string in another string

    910:    Not Collective

    912:    Input Parameters:
    913: +  haystack - string to search
    914: -  needle - string to find

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

    919:    Notes: Not for use in Fortran

    921:    Level: intermediate

    923: @*/
    924: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
    925: {
    927:   *tmp = (char*)strstr(haystack,needle);
    928:   return(0);
    929: }

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

    935: /*@C
    936:    PetscTokenFind - Locates next "token" in a string

    938:    Not Collective

    940:    Input Parameters:
    941: .  a - pointer to token

    943:    Output Parameter:
    944: .  result - location of occurance, NULL if not found

    946:    Notes:

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

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

    954:      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
    955:    second will return a null terminated y

    957:      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

    959:     Not for use in Fortran

    961:    Level: intermediate

    964: .seealso: PetscTokenCreate(), PetscTokenDestroy()
    965: @*/
    966: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
    967: {
    968:   char *ptr = a->current,token;

    971:   *result = a->current;
    972:   if (ptr && !*ptr) {*result = 0;return(0);}
    973:   token = a->token;
    974:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
    975:   while (ptr) {
    976:     if (*ptr == token) {
    977:       *ptr++ = 0;
    978:       while (*ptr == a->token) ptr++;
    979:       a->current = ptr;
    980:       break;
    981:     }
    982:     if (!*ptr) {
    983:       a->current = 0;
    984:       break;
    985:     }
    986:     ptr++;
    987:   }
    988:   return(0);
    989: }

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

    996:    Not Collective

    998:    Input Parameters:
    999: +  string - the string to look in
    1000: -  b - the separator character

    1002:    Output Parameter:
    1003: .  t- the token object

    1005:    Notes:

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

    1010:     Not for use in Fortran

    1012:    Level: intermediate

    1014: .seealso: PetscTokenFind(), PetscTokenDestroy()
    1015: @*/
    1016: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
    1017: {

    1021:   PetscNew(t);
    1022:   PetscStrallocpy(a,&(*t)->array);

    1024:   (*t)->current = (*t)->array;
    1025:   (*t)->token   = b;
    1026:   return(0);
    1027: }

    1031: /*@C
    1032:    PetscTokenDestroy - Destroys a PetscToken

    1034:    Not Collective

    1036:    Input Parameters:
    1037: .  a - pointer to token

    1039:    Level: intermediate

    1041:    Notes:     Not for use in Fortran

    1043: .seealso: PetscTokenCreate(), PetscTokenFind()
    1044: @*/
    1045: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
    1046: {

    1050:   if (!*a) return(0);
    1051:   PetscFree((*a)->array);
    1052:   PetscFree(*a);
    1053:   return(0);
    1054: }

    1059: /*@C
    1060:    PetscGetPetscDir - Gets the directory PETSc is installed in

    1062:    Not Collective

    1064:    Output Parameter:
    1065: .  dir - the directory

    1067:    Level: developer

    1069:    Notes: Not for use in Fortran

    1071: @*/
    1072: PetscErrorCode  PetscGetPetscDir(const char *dir[])
    1073: {
    1075:   *dir = PETSC_DIR;
    1076:   return(0);
    1077: }

    1081: /*@C
    1082:    PetscStrreplace - Replaces substrings in string with other substrings

    1084:    Not Collective

    1086:    Input Parameters:
    1087: +   comm - MPI_Comm of processors that are processing the string
    1088: .   aa - the string to look in
    1089: .   b - the resulting copy of a with replaced strings (b can be the same as a)
    1090: -   len - the length of b

    1092:    Notes:
    1093:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
    1094:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
    1095:       as well as any environmental variables.

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

    1100:       Not for use in Fortran

    1102:    Level: intermediate

    1104: @*/
    1105: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
    1106: {
    1108:   int            i = 0;
    1109:   size_t         l,l1,l2,l3;
    1110:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
    1111:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
    1112:   const char     *r[] = {0,0,0,0,0,0,0,0,0};
    1113:   PetscBool      flag;

    1116:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
    1117:   if (aa == b) {
    1118:     PetscStrallocpy(aa,(char**)&a);
    1119:   }
    1120:   PetscMalloc1(len,&work);

    1122:   /* get values for replaced variables */
    1123:   PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
    1124:   PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
    1125:   PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
    1126:   PetscMalloc1(256,&r[3]);
    1127:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
    1128:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
    1129:   PetscMalloc1(256,&r[6]);
    1130:   PetscMalloc1(256,&r[7]);
    1131:   PetscGetDisplay((char*)r[3],256);
    1132:   PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
    1133:   PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
    1134:   PetscGetUserName((char*)r[6],256);
    1135:   PetscGetHostName((char*)r[7],256);

    1137:   /* replace that are in environment */
    1138:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
    1139:   if (flag) {
    1140:     PetscFree(r[2]);
    1141:     PetscStrallocpy(env,(char**)&r[2]);
    1142:   }

    1144:   /* replace the requested strings */
    1145:   PetscStrncpy(b,a,len);
    1146:   while (s[i]) {
    1147:     PetscStrlen(s[i],&l);
    1148:     PetscStrstr(b,s[i],&par);
    1149:     while (par) {
    1150:       *par =  0;
    1151:       par += l;

    1153:       PetscStrlen(b,&l1);
    1154:       PetscStrlen(r[i],&l2);
    1155:       PetscStrlen(par,&l3);
    1156:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
    1157:       PetscStrcpy(work,b);
    1158:       PetscStrcat(work,r[i]);
    1159:       PetscStrcat(work,par);
    1160:       PetscStrncpy(b,work,len);
    1161:       PetscStrstr(b,s[i],&par);
    1162:     }
    1163:     i++;
    1164:   }
    1165:   i = 0;
    1166:   while (r[i]) {
    1167:     tfree = (char*)r[i];
    1168:     PetscFree(tfree);
    1169:     i++;
    1170:   }

    1172:   /* look for any other ${xxx} strings to replace from environmental variables */
    1173:   PetscStrstr(b,"${",&par);
    1174:   while (par) {
    1175:     *par  = 0;
    1176:     par  += 2;
    1177:     PetscStrcpy(work,b);
    1178:     PetscStrstr(par,"}",&epar);
    1179:     *epar = 0;
    1180:     epar += 1;
    1181:     PetscOptionsGetenv(comm,par,env,256,&flag);
    1182:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
    1183:     PetscStrcat(work,env);
    1184:     PetscStrcat(work,epar);
    1185:     PetscStrcpy(b,work);
    1186:     PetscStrstr(b,"${",&par);
    1187:   }
    1188:   PetscFree(work);
    1189:   if (aa == b) {
    1190:     PetscFree(a);
    1191:   }
    1192:   return(0);
    1193: }

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

    1200:    Not Collective

    1202:    Input Parameters:
    1203: +  n - number of strings in
    1204: .  list - list of strings to search
    1205: -  str - string to look for, empty string "" accepts default (first entry in list)

    1207:    Output Parameters:
    1208: +  value - index of matching string (if found)
    1209: -  found - boolean indicating whether string was found (can be NULL)

    1211:    Notes:
    1212:    Not for use in Fortran

    1214:    Level: advanced
    1215: @*/
    1216: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
    1217: {
    1219:   PetscBool matched;
    1220:   PetscInt i;

    1223:   if (found) *found = PETSC_FALSE;
    1224:   for (i=0; i<n; i++) {
    1225:     PetscStrcasecmp(str,list[i],&matched);
    1226:     if (matched || !str[0]) {
    1227:       if (found) *found = PETSC_TRUE;
    1228:       *value = i;
    1229:       break;
    1230:     }
    1231:   }
    1232:   return(0);
    1233: }

    1237: /*@C
    1238:    PetscEListFind - searches enum list of strings for given string, using case insensitive matching

    1240:    Not Collective

    1242:    Input Parameters:
    1243: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
    1244: -  str - string to look for

    1246:    Output Parameters:
    1247: +  value - index of matching string (if found)
    1248: -  found - boolean indicating whether string was found (can be NULL)

    1250:    Notes:
    1251:    Not for use in Fortran

    1253:    Level: advanced
    1254: @*/
    1255: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
    1256: {
    1258:   PetscInt n = 0,evalue;
    1259:   PetscBool efound;

    1262:   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");
    1263:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
    1264:   n -= 3; /* drop enum name, prefix, and null termination */
    1265:   PetscEListFind(n,enumlist,str,&evalue,&efound);
    1266:   if (efound) *value = (PetscEnum)evalue;
    1267:   if (found) *found = efound;
    1268:   return(0);
    1269: }