Actual source code: str.c
petsc-3.5.2 2014-09-08
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: PetscMalloc1((1+len),&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: PetscMalloc1((n+1),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: If the string that is being copied is of length n or larger then the entire string is not
322: copied and the file location of s is set to NULL. This is different then the behavior of
323: strncpy() which leaves s non-terminated.
325: Concepts: string copy
327: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
329: @*/
330: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
331: {
333: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
334: if (t) {
335: strncpy(s,t,n-1);
336: s[n-1] = '\0';
337: } else if (s) s[0] = 0;
338: return(0);
339: }
343: /*@C
344: PetscStrcat - Concatenates a string onto a given string
346: Not Collective
348: Input Parameters:
349: + s - string to be added to
350: - t - pointer to string to be added to end
352: Level: intermediate
354: Notes: Not for use in Fortran
356: Concepts: string copy
358: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
360: @*/
361: PetscErrorCode PetscStrcat(char s[],const char t[])
362: {
364: if (!t) return(0);
365: strcat(s,t);
366: return(0);
367: }
371: /*@C
372: PetscStrncat - Concatenates a string onto a given string, up to a given length
374: Not Collective
376: Input Parameters:
377: + s - pointer to string to be added to end
378: . t - string to be added to
379: . n - maximum length to copy
381: Level: intermediate
383: Notes: Not for use in Fortran
385: Concepts: string copy
387: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
389: @*/
390: PetscErrorCode PetscStrncat(char s[],const char t[],size_t n)
391: {
393: strncat(s,t,n);
394: return(0);
395: }
399: /*
402: Will be removed once we eliminate the __FUNCT__ paradigm
403: */
404: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
405: {
406: int c;
408: if (!a && !b) *flg = PETSC_TRUE;
409: else if (!a || !b) *flg = PETSC_FALSE;
410: else {
411: c = strcmp(a,b);
412: if (c) *flg = PETSC_FALSE;
413: else *flg = PETSC_TRUE;
414: }
415: }
419: /*@C
420: PetscStrcmp - Compares two strings,
422: Not Collective
424: Input Parameters:
425: + a - pointer to string first string
426: - b - pointer to second string
428: Output Parameter:
429: . flg - PETSC_TRUE if the two strings are equal
431: Level: intermediate
433: Notes: Not for use in Fortran
435: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
437: @*/
438: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
439: {
440: int c;
443: if (!a && !b) *flg = PETSC_TRUE;
444: else if (!a || !b) *flg = PETSC_FALSE;
445: else {
446: c = strcmp(a,b);
447: if (c) *flg = PETSC_FALSE;
448: else *flg = PETSC_TRUE;
449: }
450: return(0);
451: }
455: /*@C
456: PetscStrgrt - If first string is greater than the second
458: Not Collective
460: Input Parameters:
461: + a - pointer to first string
462: - b - pointer to second string
464: Output Parameter:
465: . flg - if the first string is greater
467: Notes:
468: Null arguments are ok, a null string is considered smaller than
469: all others
471: Not for use in Fortran
473: Level: intermediate
475: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
477: @*/
478: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
479: {
480: int c;
483: if (!a && !b) *t = PETSC_FALSE;
484: else if (a && !b) *t = PETSC_TRUE;
485: else if (!a && b) *t = PETSC_FALSE;
486: else {
487: c = strcmp(a,b);
488: if (c > 0) *t = PETSC_TRUE;
489: else *t = PETSC_FALSE;
490: }
491: return(0);
492: }
496: /*@C
497: PetscStrcasecmp - Returns true if the two strings are the same
498: except possibly for case.
500: Not Collective
502: Input Parameters:
503: + a - pointer to first string
504: - b - pointer to second string
506: Output Parameter:
507: . flg - if the two strings are the same
509: Notes:
510: Null arguments are ok
512: Not for use in Fortran
514: Level: intermediate
516: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
518: @*/
519: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
520: {
521: int c;
524: if (!a && !b) c = 0;
525: else if (!a || !b) c = 1;
526: #if defined(PETSC_HAVE_STRCASECMP)
527: else c = strcasecmp(a,b);
528: #elif defined(PETSC_HAVE_STRICMP)
529: else c = stricmp(a,b);
530: #else
531: else {
532: char *aa,*bb;
534: PetscStrallocpy(a,&aa);
535: PetscStrallocpy(b,&bb);
536: PetscStrtolower(aa);
537: PetscStrtolower(bb);
538: PetscStrcmp(aa,bb,t);
539: PetscFree(aa);
540: PetscFree(bb);
541: return(0);
542: }
543: #endif
544: if (!c) *t = PETSC_TRUE;
545: else *t = PETSC_FALSE;
546: return(0);
547: }
553: /*@C
554: PetscStrncmp - Compares two strings, up to a certain length
556: Not Collective
558: Input Parameters:
559: + a - pointer to first string
560: . b - pointer to second string
561: - n - length to compare up to
563: Output Parameter:
564: . t - if the two strings are equal
566: Level: intermediate
568: Notes: Not for use in Fortran
570: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
572: @*/
573: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
574: {
575: int c;
578: c = strncmp(a,b,n);
579: if (!c) *t = PETSC_TRUE;
580: else *t = PETSC_FALSE;
581: return(0);
582: }
586: /*@C
587: PetscStrchr - Locates first occurance of a character in a string
589: Not Collective
591: Input Parameters:
592: + a - pointer to string
593: - b - character
595: Output Parameter:
596: . c - location of occurance, NULL if not found
598: Level: intermediate
600: Notes: Not for use in Fortran
602: @*/
603: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
604: {
606: *c = (char*)strchr(a,b);
607: return(0);
608: }
612: /*@C
613: PetscStrrchr - Locates one location past the last occurance of a character in a string,
614: if the character is not found then returns entire string
616: Not Collective
618: Input Parameters:
619: + a - pointer to string
620: - b - character
622: Output Parameter:
623: . tmp - location of occurance, a if not found
625: Level: intermediate
627: Notes: Not for use in Fortran
629: @*/
630: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
631: {
633: *tmp = (char*)strrchr(a,b);
634: if (!*tmp) *tmp = (char*)a;
635: else *tmp = *tmp + 1;
636: return(0);
637: }
641: /*@C
642: PetscStrtolower - Converts string to lower case
644: Not Collective
646: Input Parameters:
647: . a - pointer to string
649: Level: intermediate
651: Notes: Not for use in Fortran
653: @*/
654: PetscErrorCode PetscStrtolower(char a[])
655: {
657: while (*a) {
658: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
659: a++;
660: }
661: return(0);
662: }
666: /*@C
667: PetscStrtolower - Converts string to upper case
669: Not Collective
671: Input Parameters:
672: . a - pointer to string
674: Level: intermediate
676: Notes: Not for use in Fortran
678: @*/
679: PetscErrorCode PetscStrtoupper(char a[])
680: {
682: while (*a) {
683: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
684: a++;
685: }
686: return(0);
687: }
691: /*@C
692: PetscStrendswith - Determines if a string ends with a certain string
694: Not Collective
696: Input Parameters:
697: + a - pointer to string
698: - b - string to endwith
700: Output Parameter:
701: . flg - PETSC_TRUE or PETSC_FALSE
703: Notes: Not for use in Fortran
705: Level: intermediate
707: @*/
708: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
709: {
710: char *test;
712: size_t na,nb;
715: *flg = PETSC_FALSE;
716: PetscStrrstr(a,b,&test);
717: if (test) {
718: PetscStrlen(a,&na);
719: PetscStrlen(b,&nb);
720: if (a+na-nb == test) *flg = PETSC_TRUE;
721: }
722: return(0);
723: }
727: /*@C
728: PetscStrbeginswith - Determines if a string begins with a certain string
730: Not Collective
732: Input Parameters:
733: + a - pointer to string
734: - b - string to beginwith
736: Output Parameter:
737: . flg - PETSC_TRUE or PETSC_FALSE
739: Notes: Not for use in Fortran
741: Level: intermediate
743: @*/
744: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
745: {
746: char *test;
750: *flg = PETSC_FALSE;
751: PetscStrrstr(a,b,&test);
752: if (test && (test == a)) *flg = PETSC_TRUE;
753: return(0);
754: }
759: /*@C
760: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
762: Not Collective
764: Input Parameters:
765: + a - pointer to string
766: - bs - strings to endwith (last entry must be null)
768: Output Parameter:
769: . cnt - the index of the string it ends with or 1+the last possible index
771: Notes: Not for use in Fortran
773: Level: intermediate
775: @*/
776: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
777: {
778: PetscBool flg;
782: *cnt = 0;
783: while (bs[*cnt]) {
784: PetscStrendswith(a,bs[*cnt],&flg);
785: if (flg) return(0);
786: *cnt += 1;
787: }
788: return(0);
789: }
793: /*@C
794: PetscStrrstr - Locates last occurance of string in another string
796: Not Collective
798: Input Parameters:
799: + a - pointer to string
800: - b - string to find
802: Output Parameter:
803: . tmp - location of occurance
805: Notes: Not for use in Fortran
807: Level: intermediate
809: @*/
810: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
811: {
812: const char *stmp = a, *ltmp = 0;
815: while (stmp) {
816: stmp = (char*)strstr(stmp,b);
817: if (stmp) {ltmp = stmp;stmp++;}
818: }
819: *tmp = (char*)ltmp;
820: return(0);
821: }
825: /*@C
826: PetscStrstr - Locates first occurance of string in another string
828: Not Collective
830: Input Parameters:
831: + haystack - string to search
832: - needle - string to find
834: Output Parameter:
835: . tmp - location of occurance, is a NULL if the string is not found
837: Notes: Not for use in Fortran
839: Level: intermediate
841: @*/
842: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
843: {
845: *tmp = (char*)strstr(haystack,needle);
846: return(0);
847: }
849: struct _p_PetscToken {char token;char *array;char *current;};
853: /*@C
854: PetscTokenFind - Locates next "token" in a string
856: Not Collective
858: Input Parameters:
859: . a - pointer to token
861: Output Parameter:
862: . result - location of occurance, NULL if not found
864: Notes:
866: This version is different from the system version in that
867: it allows you to pass a read-only string into the function.
869: This version also treats all characters etc. inside a double quote "
870: as a single token.
872: Not for use in Fortran
874: Level: intermediate
877: .seealso: PetscTokenCreate(), PetscTokenDestroy()
878: @*/
879: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
880: {
881: char *ptr = a->current,token;
884: *result = a->current;
885: if (ptr && !*ptr) {*result = 0;return(0);}
886: token = a->token;
887: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
888: while (ptr) {
889: if (*ptr == token) {
890: *ptr++ = 0;
891: while (*ptr == a->token) ptr++;
892: a->current = ptr;
893: break;
894: }
895: if (!*ptr) {
896: a->current = 0;
897: break;
898: }
899: ptr++;
900: }
901: return(0);
902: }
906: /*@C
907: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
909: Not Collective
911: Input Parameters:
912: + string - the string to look in
913: - token - the character to look for
915: Output Parameter:
916: . a - pointer to token
918: Notes:
920: This version is different from the system version in that
921: it allows you to pass a read-only string into the function.
923: Not for use in Fortran
925: Level: intermediate
927: .seealso: PetscTokenFind(), PetscTokenDestroy()
928: @*/
929: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
930: {
934: PetscNew(t);
935: PetscStrallocpy(a,&(*t)->array);
937: (*t)->current = (*t)->array;
938: (*t)->token = b;
939: return(0);
940: }
944: /*@C
945: PetscTokenDestroy - Destroys a PetscToken
947: Not Collective
949: Input Parameters:
950: . a - pointer to token
952: Level: intermediate
954: Notes: Not for use in Fortran
956: .seealso: PetscTokenCreate(), PetscTokenFind()
957: @*/
958: PetscErrorCode PetscTokenDestroy(PetscToken *a)
959: {
963: if (!*a) return(0);
964: PetscFree((*a)->array);
965: PetscFree(*a);
966: return(0);
967: }
972: /*@C
973: PetscGetPetscDir - Gets the directory PETSc is installed in
975: Not Collective
977: Output Parameter:
978: . dir - the directory
980: Level: developer
982: Notes: Not for use in Fortran
984: @*/
985: PetscErrorCode PetscGetPetscDir(const char *dir[])
986: {
988: *dir = PETSC_DIR;
989: return(0);
990: }
994: /*@C
995: PetscStrreplace - Replaces substrings in string with other substrings
997: Not Collective
999: Input Parameters:
1000: + comm - MPI_Comm of processors that are processing the string
1001: . aa - the string to look in
1002: . b - the resulting copy of a with replaced strings (b can be the same as a)
1003: - len - the length of b
1005: Notes:
1006: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1007: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1008: as well as any environmental variables.
1010: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1011: PETSc was built with and do not use environmental variables.
1013: Not for use in Fortran
1015: Level: intermediate
1017: @*/
1018: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1019: {
1021: int i = 0;
1022: size_t l,l1,l2,l3;
1023: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1024: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1025: const char *r[] = {0,0,0,0,0,0,0,0,0};
1026: PetscBool flag;
1029: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1030: if (aa == b) {
1031: PetscStrallocpy(aa,(char**)&a);
1032: }
1033: PetscMalloc1(len,&work);
1035: /* get values for replaced variables */
1036: PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1037: PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1038: PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1039: PetscMalloc1(256,&r[3]);
1040: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1041: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1042: PetscMalloc1(256,&r[6]);
1043: PetscMalloc1(256,&r[7]);
1044: PetscGetDisplay((char*)r[3],256);
1045: PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1046: PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1047: PetscGetUserName((char*)r[6],256);
1048: PetscGetHostName((char*)r[7],256);
1050: /* replace that are in environment */
1051: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1052: if (flag) {
1053: PetscFree(r[2]);
1054: PetscStrallocpy(env,(char**)&r[2]);
1055: }
1057: /* replace the requested strings */
1058: PetscStrncpy(b,a,len);
1059: while (s[i]) {
1060: PetscStrlen(s[i],&l);
1061: PetscStrstr(b,s[i],&par);
1062: while (par) {
1063: *par = 0;
1064: par += l;
1066: PetscStrlen(b,&l1);
1067: PetscStrlen(r[i],&l2);
1068: PetscStrlen(par,&l3);
1069: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1070: PetscStrcpy(work,b);
1071: PetscStrcat(work,r[i]);
1072: PetscStrcat(work,par);
1073: PetscStrncpy(b,work,len);
1074: PetscStrstr(b,s[i],&par);
1075: }
1076: i++;
1077: }
1078: i = 0;
1079: while (r[i]) {
1080: tfree = (char*)r[i];
1081: PetscFree(tfree);
1082: i++;
1083: }
1085: /* look for any other ${xxx} strings to replace from environmental variables */
1086: PetscStrstr(b,"${",&par);
1087: while (par) {
1088: *par = 0;
1089: par += 2;
1090: PetscStrcpy(work,b);
1091: PetscStrstr(par,"}",&epar);
1092: *epar = 0;
1093: epar += 1;
1094: PetscOptionsGetenv(comm,par,env,256,&flag);
1095: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1096: PetscStrcat(work,env);
1097: PetscStrcat(work,epar);
1098: PetscStrcpy(b,work);
1099: PetscStrstr(b,"${",&par);
1100: }
1101: PetscFree(work);
1102: if (aa == b) {
1103: PetscFree(a);
1104: }
1105: return(0);
1106: }
1110: /*@C
1111: PetscEListFind - searches list of strings for given string, using case insensitive matching
1113: Not Collective
1115: Input Parameters:
1116: + n - number of strings in
1117: . list - list of strings to search
1118: - str - string to look for, empty string "" accepts default (first entry in list)
1120: Output Parameters:
1121: + value - index of matching string (if found)
1122: - found - boolean indicating whether string was found (can be NULL)
1124: Notes:
1125: Not for use in Fortran
1127: Level: advanced
1128: @*/
1129: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1130: {
1132: PetscBool matched;
1133: PetscInt i;
1136: if (found) *found = PETSC_FALSE;
1137: for (i=0; i<n; i++) {
1138: PetscStrcasecmp(str,list[i],&matched);
1139: if (matched || !str[0]) {
1140: if (found) *found = PETSC_TRUE;
1141: *value = i;
1142: break;
1143: }
1144: }
1145: return(0);
1146: }
1150: /*@C
1151: PetscEListFind - searches enum list of strings for given string, using case insensitive matching
1153: Not Collective
1155: Input Parameters:
1156: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1157: - str - string to look for
1159: Output Parameters:
1160: + value - index of matching string (if found)
1161: - found - boolean indicating whether string was found (can be NULL)
1163: Notes:
1164: Not for use in Fortran
1166: Level: advanced
1167: @*/
1168: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1169: {
1171: PetscInt n,evalue;
1172: PetscBool efound;
1175: for (n = 0; enumlist[n]; n++) {
1176: if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1177: }
1178: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1179: n -= 3; /* drop enum name, prefix, and null termination */
1180: PetscEListFind(n,enumlist,str,&evalue,&efound);
1181: if (efound) *value = (PetscEnum)evalue;
1182: if (found) *found = efound;
1183: return(0);
1184: }