Actual source code: str.c

petsc-3.4.4 2014-03-13
  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 - Seperates 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,n,*lens,cnt = 0;
 46:   PetscBool flg = PETSC_FALSE;

 48:   if (!s) n = 0;
 49:   else    n = strlen(s);
 50:   *argc = 0;
 51:   if (!n) {
 52:     *args = 0;
 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:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 63:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 64:   for (i=0; i<*argc; i++) lens[i] = 0;

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

 75:   for (i=0; i<*argc; i++) {
 76:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char)); if (!(*args)[i]) return PETSC_ERR_MEM;
 77:   }
 78:   free(lens);
 79:   (*args)[*argc] = 0;

 81:   *argc = 0;
 82:   for (i=0; i<n; i++) {
 83:     if (s[i] != sp) break;
 84:   }
 85:   for (;i<n+1; i++) {
 86:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
 87:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
 88:   }
 89:   return 0;
 90: }

 94: /*@C
 95:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

 97:    Not Collective

 99:    Output Parameters:
100: +  argc - the number of arguments
101: -  args - the array of arguments

103:    Level: intermediate

105:    Concepts: command line arguments

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

109:    Not for use in Fortran

111: .seealso: PetscStrToArray()

113: @*/
114: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
115: {
116:   PetscInt i;

118:   for (i=0; i<argc; i++) free(args[i]);
119:   if (args) free(args);
120:   return 0;
121: }

125: /*@C
126:    PetscStrlen - Gets length of a string

128:    Not Collective

130:    Input Parameters:
131: .  s - pointer to string

133:    Output Parameter:
134: .  len - length in bytes

136:    Level: intermediate

138:    Note:
139:    This routine is analogous to strlen().

141:    Null string returns a length of zero

143:    Not for use in Fortran

145:   Concepts: string length

147: @*/
148: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
149: {
151:   if (!s) *len = 0;
152:   else    *len = strlen(s);
153:   return(0);
154: }

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

161:    Not Collective

163:    Input Parameters:
164: .  s - pointer to string

166:    Output Parameter:
167: .  t - the copied string

169:    Level: intermediate

171:    Note:
172:       Null string returns a new null string

174:       Not for use in Fortran

176:   Concepts: string copy

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

186:   if (s) {
187:     PetscStrlen(s,&len);
188:     PetscMalloc((1+len)*sizeof(char),&tmp);
189:     PetscStrcpy(tmp,s);
190:   }
191:   *t = tmp;
192:   return(0);
193: }

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

200:    Not Collective

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

205:    Output Parameter:
206: .  t - the copied array string

208:    Level: intermediate

210:    Note:
211:       Not for use in Fortran

213:   Concepts: string copy

215: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

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

224:   while (list[n++]) ;
225:   PetscMalloc((n+1)*sizeof(char**),t);
226:   for (i=0; i<n; i++) {
227:     PetscStrallocpy(list[i],(*t)+i);
228:   }
229:   (*t)[n] = NULL;
230:   return(0);
231: }

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: Not for use in Fortran

249: .seealso: PetscStrArrayallocpy()

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

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

269: /*@C
270:    PetscStrcpy - Copies a string

272:    Not Collective

274:    Input Parameters:
275: .  t - pointer to string

277:    Output Parameter:
278: .  s - the copied string

280:    Level: intermediate

282:    Notes:
283:      Null string returns a string starting with zero

285:      Not for use in Fortran

287:   Concepts: string copy

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

291: @*/

293: PetscErrorCode  PetscStrcpy(char s[],const char t[])
294: {
296:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
297:   if (t) strcpy(s,t);
298:   else if (s) s[0] = 0;
299:   return(0);
300: }

304: /*@C
305:    PetscStrncpy - Copies a string up to a certain length

307:    Not Collective

309:    Input Parameters:
310: +  t - pointer to string
311: -  n - the length to copy

313:    Output Parameter:
314: .  s - the copied string

316:    Level: intermediate

318:    Note:
319:      Null string returns a string starting with zero

321:   Concepts: string copy

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

325: @*/
326: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
327: {
329:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
330:   if (t) strncpy(s,t,n);
331:   else if (s) s[0] = 0;
332:   return(0);
333: }

337: /*@C
338:    PetscStrcat - Concatenates a string onto a given string

340:    Not Collective

342:    Input Parameters:
343: +  s - string to be added to
344: -  t - pointer to string to be added to end

346:    Level: intermediate

348:    Notes: Not for use in Fortran

350:   Concepts: string copy

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

354: @*/
355: PetscErrorCode  PetscStrcat(char s[],const char t[])
356: {
358:   if (!t) return(0);
359:   strcat(s,t);
360:   return(0);
361: }

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

368:    Not Collective

370:    Input Parameters:
371: +  s - pointer to string to be added to end
372: .  t - string to be added to
373: .  n - maximum length to copy

375:    Level: intermediate

377:   Notes:    Not for use in Fortran

379:   Concepts: string copy

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

383: @*/
384: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
385: {
387:   strncat(s,t,n);
388:   return(0);
389: }

393: /*

396:    Will be removed once we eliminate the __FUNCT__ paradigm
397: */
398: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
399: {
400:   int c;

402:   if (!a && !b)      *flg = PETSC_TRUE;
403:   else if (!a || !b) *flg = PETSC_FALSE;
404:   else {
405:     c = strcmp(a,b);
406:     if (c) *flg = PETSC_FALSE;
407:     else   *flg = PETSC_TRUE;
408:   }
409: }

413: /*@C
414:    PetscStrcmp - Compares two strings,

416:    Not Collective

418:    Input Parameters:
419: +  a - pointer to string first string
420: -  b - pointer to second string

422:    Output Parameter:
423: .  flg - PETSC_TRUE if the two strings are equal

425:    Level: intermediate

427:    Notes:    Not for use in Fortran

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

431: @*/
432: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
433: {
434:   int c;

437:   if (!a && !b)      *flg = PETSC_TRUE;
438:   else if (!a || !b) *flg = PETSC_FALSE;
439:   else {
440:     c = strcmp(a,b);
441:     if (c) *flg = PETSC_FALSE;
442:     else   *flg = PETSC_TRUE;
443:   }
444:   return(0);
445: }

449: /*@C
450:    PetscStrgrt - If first string is greater than the second

452:    Not Collective

454:    Input Parameters:
455: +  a - pointer to first string
456: -  b - pointer to second string

458:    Output Parameter:
459: .  flg - if the first string is greater

461:    Notes:
462:     Null arguments are ok, a null string is considered smaller than
463:     all others

465:    Not for use in Fortran

467:    Level: intermediate

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

471: @*/
472: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
473: {
474:   int c;

477:   if (!a && !b) *t = PETSC_FALSE;
478:   else if (a && !b) *t = PETSC_TRUE;
479:   else if (!a && b) *t = PETSC_FALSE;
480:   else {
481:     c = strcmp(a,b);
482:     if (c > 0) *t = PETSC_TRUE;
483:     else       *t = PETSC_FALSE;
484:   }
485:   return(0);
486: }

490: /*@C
491:    PetscStrcasecmp - Returns true if the two strings are the same
492:      except possibly for case.

494:    Not Collective

496:    Input Parameters:
497: +  a - pointer to first string
498: -  b - pointer to second string

500:    Output Parameter:
501: .  flg - if the two strings are the same

503:    Notes:
504:     Null arguments are ok

506:    Not for use in Fortran

508:    Level: intermediate

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

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

518:   if (!a && !b) c = 0;
519:   else if (!a || !b) c = 1;
520: #if defined(PETSC_HAVE_STRCASECMP)
521:   else c = strcasecmp(a,b);
522: #elif defined(PETSC_HAVE_STRICMP)
523:   else c = stricmp(a,b);
524: #else
525:   else {
526:     char           *aa,*bb;
528:     PetscStrallocpy(a,&aa);
529:     PetscStrallocpy(b,&bb);
530:     PetscStrtolower(aa);
531:     PetscStrtolower(bb);
532:     PetscStrcmp(aa,bb,t);
533:     PetscFree(aa);
534:     PetscFree(bb);
535:     return(0);
536:   }
537: #endif
538:   if (!c) *t = PETSC_TRUE;
539:   else    *t = PETSC_FALSE;
540:   return(0);
541: }



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

550:    Not Collective

552:    Input Parameters:
553: +  a - pointer to first string
554: .  b - pointer to second string
555: -  n - length to compare up to

557:    Output Parameter:
558: .  t - if the two strings are equal

560:    Level: intermediate

562:    Notes:    Not for use in Fortran

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

566: @*/
567: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
568: {
569:   int c;

572:   c = strncmp(a,b,n);
573:   if (!c) *t = PETSC_TRUE;
574:   else    *t = PETSC_FALSE;
575:   return(0);
576: }

580: /*@C
581:    PetscStrchr - Locates first occurance of a character in a string

583:    Not Collective

585:    Input Parameters:
586: +  a - pointer to string
587: -  b - character

589:    Output Parameter:
590: .  c - location of occurance, NULL if not found

592:    Level: intermediate

594:    Notes:    Not for use in Fortran

596: @*/
597: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
598: {
600:   *c = (char*)strchr(a,b);
601:   return(0);
602: }

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

610:    Not Collective

612:    Input Parameters:
613: +  a - pointer to string
614: -  b - character

616:    Output Parameter:
617: .  tmp - location of occurance, a if not found

619:    Level: intermediate

621:    Notes:    Not for use in Fortran

623: @*/
624: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
625: {
627:   *tmp = (char*)strrchr(a,b);
628:   if (!*tmp) *tmp = (char*)a;
629:   else *tmp = *tmp + 1;
630:   return(0);
631: }

635: /*@C
636:    PetscStrtolower - Converts string to lower case

638:    Not Collective

640:    Input Parameters:
641: .  a - pointer to string

643:    Level: intermediate

645:    Notes:    Not for use in Fortran

647: @*/
648: PetscErrorCode  PetscStrtolower(char a[])
649: {
651:   while (*a) {
652:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
653:     a++;
654:   }
655:   return(0);
656: }

660: /*@C
661:    PetscStrtolower - Converts string to upper case

663:    Not Collective

665:    Input Parameters:
666: .  a - pointer to string

668:    Level: intermediate

670:    Notes:    Not for use in Fortran

672: @*/
673: PetscErrorCode  PetscStrtoupper(char a[])
674: {
676:   while (*a) {
677:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
678:     a++;
679:   }
680:   return(0);
681: }

685: /*@C
686:    PetscStrendswith - Determines if a string ends with a certain string

688:    Not Collective

690:    Input Parameters:
691: +  a - pointer to string
692: -  b - string to endwith

694:    Output Parameter:
695: .  flg - PETSC_TRUE or PETSC_FALSE

697:    Notes:     Not for use in Fortran

699:    Level: intermediate

701: @*/
702: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
703: {
704:   char           *test;
706:   size_t         na,nb;

709:   *flg = PETSC_FALSE;
710:   PetscStrrstr(a,b,&test);
711:   if (test) {
712:     PetscStrlen(a,&na);
713:     PetscStrlen(b,&nb);
714:     if (a+na-nb == test) *flg = PETSC_TRUE;
715:   }
716:   return(0);
717: }

721: /*@C
722:    PetscStrbeginswith - Determines if a string begins with a certain string

724:    Not Collective

726:    Input Parameters:
727: +  a - pointer to string
728: -  b - string to beginwith

730:    Output Parameter:
731: .  flg - PETSC_TRUE or PETSC_FALSE

733:    Notes:     Not for use in Fortran

735:    Level: intermediate

737: @*/
738: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
739: {
740:   char           *test;

744:   *flg = PETSC_FALSE;
745:   PetscStrrstr(a,b,&test);
746:   if (test && (test == a)) *flg = PETSC_TRUE;
747:   return(0);
748: }


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

756:    Not Collective

758:    Input Parameters:
759: +  a - pointer to string
760: -  bs - strings to endwith (last entry must be null)

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

765:    Notes:     Not for use in Fortran

767:    Level: intermediate

769: @*/
770: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
771: {
772:   PetscBool      flg;

776:   *cnt = 0;
777:   while (bs[*cnt]) {
778:     PetscStrendswith(a,bs[*cnt],&flg);
779:     if (flg) return(0);
780:     *cnt += 1;
781:   }
782:   return(0);
783: }

787: /*@C
788:    PetscStrrstr - Locates last occurance of string in another string

790:    Not Collective

792:    Input Parameters:
793: +  a - pointer to string
794: -  b - string to find

796:    Output Parameter:
797: .  tmp - location of occurance

799:    Notes:     Not for use in Fortran

801:    Level: intermediate

803: @*/
804: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
805: {
806:   const char *stmp = a, *ltmp = 0;

809:   while (stmp) {
810:     stmp = (char*)strstr(stmp,b);
811:     if (stmp) {ltmp = stmp;stmp++;}
812:   }
813:   *tmp = (char*)ltmp;
814:   return(0);
815: }

819: /*@C
820:    PetscStrstr - Locates first occurance of string in another string

822:    Not Collective

824:    Input Parameters:
825: +  haystack - string to search
826: -  needle - string to find

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

831:    Notes: Not for use in Fortran

833:    Level: intermediate

835: @*/
836: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
837: {
839:   *tmp = (char*)strstr(haystack,needle);
840:   return(0);
841: }

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

847: /*@C
848:    PetscTokenFind - Locates next "token" in a string

850:    Not Collective

852:    Input Parameters:
853: .  a - pointer to token

855:    Output Parameter:
856: .  result - location of occurance, NULL if not found

858:    Notes:

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

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

866:     Not for use in Fortran

868:    Level: intermediate


871: .seealso: PetscTokenCreate(), PetscTokenDestroy()
872: @*/
873: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
874: {
875:   char *ptr = a->current,token;

878:   *result = a->current;
879:   if (ptr && !*ptr) {*result = 0;return(0);}
880:   token = a->token;
881:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
882:   while (ptr) {
883:     if (*ptr == token) {
884:       *ptr++ = 0;
885:       while (*ptr == a->token) ptr++;
886:       a->current = ptr;
887:       break;
888:     }
889:     if (!*ptr) {
890:       a->current = 0;
891:       break;
892:     }
893:     ptr++;
894:   }
895:   return(0);
896: }

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

903:    Not Collective

905:    Input Parameters:
906: +  string - the string to look in
907: -  token - the character to look for

909:    Output Parameter:
910: .  a - pointer to token

912:    Notes:

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

917:     Not for use in Fortran

919:    Level: intermediate

921: .seealso: PetscTokenFind(), PetscTokenDestroy()
922: @*/
923: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
924: {

928:   PetscNew(struct _p_PetscToken,t);
929:   PetscStrallocpy(a,&(*t)->array);

931:   (*t)->current = (*t)->array;
932:   (*t)->token   = b;
933:   return(0);
934: }

938: /*@C
939:    PetscTokenDestroy - Destroys a PetscToken

941:    Not Collective

943:    Input Parameters:
944: .  a - pointer to token

946:    Level: intermediate

948:    Notes:     Not for use in Fortran

950: .seealso: PetscTokenCreate(), PetscTokenFind()
951: @*/
952: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
953: {

957:   if (!*a) return(0);
958:   PetscFree((*a)->array);
959:   PetscFree(*a);
960:   return(0);
961: }


966: /*@C
967:    PetscGetPetscDir - Gets the directory PETSc is installed in

969:    Not Collective

971:    Output Parameter:
972: .  dir - the directory

974:    Level: developer

976:    Notes: Not for use in Fortran

978: @*/
979: PetscErrorCode  PetscGetPetscDir(const char *dir[])
980: {
982:   *dir = PETSC_DIR;
983:   return(0);
984: }

988: /*@C
989:    PetscStrreplace - Replaces substrings in string with other substrings

991:    Not Collective

993:    Input Parameters:
994: +   comm - MPI_Comm of processors that are processing the string
995: .   aa - the string to look in
996: .   b - the resulting copy of a with replaced strings (b can be the same as a)
997: -   len - the length of b

999:    Notes:
1000:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1001:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1002:       as well as any environmental variables.

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

1007:       Not for use in Fortran

1009:    Level: intermediate

1011: @*/
1012: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1013: {
1015:   int            i = 0;
1016:   size_t         l,l1,l2,l3;
1017:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1018:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1019:   const char     *r[] = {0,0,0,0,0,0,0,0,0};
1020:   PetscBool      flag;

1023:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1024:   if (aa == b) {
1025:     PetscStrallocpy(aa,(char**)&a);
1026:   }
1027:   PetscMalloc(len*sizeof(char*),&work);

1029:   /* get values for replaced variables */
1030:   PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1031:   PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1032:   PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1033:   PetscMalloc(256*sizeof(char),&r[3]);
1034:   PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);
1035:   PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);
1036:   PetscMalloc(256*sizeof(char),&r[6]);
1037:   PetscMalloc(256*sizeof(char),&r[7]);
1038:   PetscGetDisplay((char*)r[3],256);
1039:   PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1040:   PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1041:   PetscGetUserName((char*)r[6],256);
1042:   PetscGetHostName((char*)r[7],256);

1044:   /* replace that are in environment */
1045:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1046:   if (flag) {
1047:     PetscStrallocpy(env,(char**)&r[2]);
1048:   }

1050:   /* replace the requested strings */
1051:   PetscStrncpy(b,a,len);
1052:   while (s[i]) {
1053:     PetscStrlen(s[i],&l);
1054:     PetscStrstr(b,s[i],&par);
1055:     while (par) {
1056:       *par =  0;
1057:       par += l;

1059:       PetscStrlen(b,&l1);
1060:       PetscStrlen(r[i],&l2);
1061:       PetscStrlen(par,&l3);
1062:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1063:       PetscStrcpy(work,b);
1064:       PetscStrcat(work,r[i]);
1065:       PetscStrcat(work,par);
1066:       PetscStrncpy(b,work,len);
1067:       PetscStrstr(b,s[i],&par);
1068:     }
1069:     i++;
1070:   }
1071:   i = 0;
1072:   while (r[i]) {
1073:     tfree = (char*)r[i];
1074:     PetscFree(tfree);
1075:     i++;
1076:   }

1078:   /* look for any other ${xxx} strings to replace from environmental variables */
1079:   PetscStrstr(b,"${",&par);
1080:   while (par) {
1081:     *par  = 0;
1082:     par  += 2;
1083:     PetscStrcpy(work,b);
1084:     PetscStrstr(par,"}",&epar);
1085:     *epar = 0;
1086:     epar += 1;
1087:     PetscOptionsGetenv(comm,par,env,256,&flag);
1088:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1089:     PetscStrcat(work,env);
1090:     PetscStrcat(work,epar);
1091:     PetscStrcpy(b,work);
1092:     PetscStrstr(b,"${",&par);
1093:   }
1094:   PetscFree(work);
1095:   if (aa == b) {
1096:     PetscFree(a);
1097:   }
1098:   return(0);
1099: }

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

1106:    Not Collective

1108:    Input Parameters:
1109: +  n - number of strings in
1110: .  list - list of strings to search
1111: -  str - string to look for, empty string "" accepts default (first entry in list)

1113:    Output Parameters:
1114: +  value - index of matching string (if found)
1115: -  found - boolean indicating whether string was found (can be NULL)

1117:    Notes:
1118:    Not for use in Fortran

1120:    Level: advanced
1121: @*/
1122: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1123: {
1125:   PetscBool matched;
1126:   PetscInt i;

1129:   if (found) *found = PETSC_FALSE;
1130:   for (i=0; i<n; i++) {
1131:     PetscStrcasecmp(str,list[i],&matched);
1132:     if (matched || !str[0]) {
1133:       if (found) *found = PETSC_TRUE;
1134:       *value = i;
1135:       break;
1136:     }
1137:   }
1138:   return(0);
1139: }

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

1146:    Not Collective

1148:    Input Parameters:
1149: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1150: -  str - string to look for

1152:    Output Parameters:
1153: +  value - index of matching string (if found)
1154: -  found - boolean indicating whether string was found (can be NULL)

1156:    Notes:
1157:    Not for use in Fortran

1159:    Level: advanced
1160: @*/
1161: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1162: {
1164:   PetscInt n,evalue;
1165:   PetscBool efound;

1168:   for (n = 0; enumlist[n]; n++) {
1169:     if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1170:   }
1171:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1172:   n -= 3;                       /* drop enum name, prefix, and null termination */
1173:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1174:   if (efound) *value = (PetscEnum)evalue;
1175:   if (found) *found = efound;
1176:   return(0);
1177: }