Actual source code: str.c
petsc-3.5.4 2015-05-23
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: if (n > 1) {
336: strncpy(s,t,n-1);
337: s[n-1] = '\0';
338: } else {
339: s[0] = '\0';
340: }
341: } else if (s) s[0] = 0;
342: return(0);
343: }
347: /*@C
348: PetscStrcat - Concatenates a string onto a given string
350: Not Collective
352: Input Parameters:
353: + s - string to be added to
354: - t - pointer to string to be added to end
356: Level: intermediate
358: Notes: Not for use in Fortran
360: Concepts: string copy
362: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
364: @*/
365: PetscErrorCode PetscStrcat(char s[],const char t[])
366: {
368: if (!t) return(0);
369: strcat(s,t);
370: return(0);
371: }
375: /*@C
376: PetscStrncat - Concatenates a string onto a given string, up to a given length
378: Not Collective
380: Input Parameters:
381: + s - pointer to string to be added to end
382: . t - string to be added to
383: . n - maximum length to copy
385: Level: intermediate
387: Notes: Not for use in Fortran
389: Concepts: string copy
391: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
393: @*/
394: PetscErrorCode PetscStrncat(char s[],const char t[],size_t n)
395: {
397: strncat(s,t,n);
398: return(0);
399: }
403: /*
406: Will be removed once we eliminate the __FUNCT__ paradigm
407: */
408: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
409: {
410: int c;
412: if (!a && !b) *flg = PETSC_TRUE;
413: else if (!a || !b) *flg = PETSC_FALSE;
414: else {
415: c = strcmp(a,b);
416: if (c) *flg = PETSC_FALSE;
417: else *flg = PETSC_TRUE;
418: }
419: }
423: /*@C
424: PetscStrcmp - Compares two strings,
426: Not Collective
428: Input Parameters:
429: + a - pointer to string first string
430: - b - pointer to second string
432: Output Parameter:
433: . flg - PETSC_TRUE if the two strings are equal
435: Level: intermediate
437: Notes: Not for use in Fortran
439: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
441: @*/
442: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
443: {
444: int c;
447: if (!a && !b) *flg = PETSC_TRUE;
448: else if (!a || !b) *flg = PETSC_FALSE;
449: else {
450: c = strcmp(a,b);
451: if (c) *flg = PETSC_FALSE;
452: else *flg = PETSC_TRUE;
453: }
454: return(0);
455: }
459: /*@C
460: PetscStrgrt - If first string is greater than the second
462: Not Collective
464: Input Parameters:
465: + a - pointer to first string
466: - b - pointer to second string
468: Output Parameter:
469: . flg - if the first string is greater
471: Notes:
472: Null arguments are ok, a null string is considered smaller than
473: all others
475: Not for use in Fortran
477: Level: intermediate
479: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
481: @*/
482: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
483: {
484: int c;
487: if (!a && !b) *t = PETSC_FALSE;
488: else if (a && !b) *t = PETSC_TRUE;
489: else if (!a && b) *t = PETSC_FALSE;
490: else {
491: c = strcmp(a,b);
492: if (c > 0) *t = PETSC_TRUE;
493: else *t = PETSC_FALSE;
494: }
495: return(0);
496: }
500: /*@C
501: PetscStrcasecmp - Returns true if the two strings are the same
502: except possibly for case.
504: Not Collective
506: Input Parameters:
507: + a - pointer to first string
508: - b - pointer to second string
510: Output Parameter:
511: . flg - if the two strings are the same
513: Notes:
514: Null arguments are ok
516: Not for use in Fortran
518: Level: intermediate
520: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
522: @*/
523: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
524: {
525: int c;
528: if (!a && !b) c = 0;
529: else if (!a || !b) c = 1;
530: #if defined(PETSC_HAVE_STRCASECMP)
531: else c = strcasecmp(a,b);
532: #elif defined(PETSC_HAVE_STRICMP)
533: else c = stricmp(a,b);
534: #else
535: else {
536: char *aa,*bb;
538: PetscStrallocpy(a,&aa);
539: PetscStrallocpy(b,&bb);
540: PetscStrtolower(aa);
541: PetscStrtolower(bb);
542: PetscStrcmp(aa,bb,t);
543: PetscFree(aa);
544: PetscFree(bb);
545: return(0);
546: }
547: #endif
548: if (!c) *t = PETSC_TRUE;
549: else *t = PETSC_FALSE;
550: return(0);
551: }
557: /*@C
558: PetscStrncmp - Compares two strings, up to a certain length
560: Not Collective
562: Input Parameters:
563: + a - pointer to first string
564: . b - pointer to second string
565: - n - length to compare up to
567: Output Parameter:
568: . t - if the two strings are equal
570: Level: intermediate
572: Notes: Not for use in Fortran
574: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
576: @*/
577: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
578: {
579: int c;
582: c = strncmp(a,b,n);
583: if (!c) *t = PETSC_TRUE;
584: else *t = PETSC_FALSE;
585: return(0);
586: }
590: /*@C
591: PetscStrchr - Locates first occurance of a character in a string
593: Not Collective
595: Input Parameters:
596: + a - pointer to string
597: - b - character
599: Output Parameter:
600: . c - location of occurance, NULL if not found
602: Level: intermediate
604: Notes: Not for use in Fortran
606: @*/
607: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
608: {
610: *c = (char*)strchr(a,b);
611: return(0);
612: }
616: /*@C
617: PetscStrrchr - Locates one location past the last occurance of a character in a string,
618: if the character is not found then returns entire string
620: Not Collective
622: Input Parameters:
623: + a - pointer to string
624: - b - character
626: Output Parameter:
627: . tmp - location of occurance, a if not found
629: Level: intermediate
631: Notes: Not for use in Fortran
633: @*/
634: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
635: {
637: *tmp = (char*)strrchr(a,b);
638: if (!*tmp) *tmp = (char*)a;
639: else *tmp = *tmp + 1;
640: return(0);
641: }
645: /*@C
646: PetscStrtolower - Converts string to lower case
648: Not Collective
650: Input Parameters:
651: . a - pointer to string
653: Level: intermediate
655: Notes: Not for use in Fortran
657: @*/
658: PetscErrorCode PetscStrtolower(char a[])
659: {
661: while (*a) {
662: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
663: a++;
664: }
665: return(0);
666: }
670: /*@C
671: PetscStrtolower - Converts string to upper case
673: Not Collective
675: Input Parameters:
676: . a - pointer to string
678: Level: intermediate
680: Notes: Not for use in Fortran
682: @*/
683: PetscErrorCode PetscStrtoupper(char a[])
684: {
686: while (*a) {
687: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
688: a++;
689: }
690: return(0);
691: }
695: /*@C
696: PetscStrendswith - Determines if a string ends with a certain string
698: Not Collective
700: Input Parameters:
701: + a - pointer to string
702: - b - string to endwith
704: Output Parameter:
705: . flg - PETSC_TRUE or PETSC_FALSE
707: Notes: Not for use in Fortran
709: Level: intermediate
711: @*/
712: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
713: {
714: char *test;
716: size_t na,nb;
719: *flg = PETSC_FALSE;
720: PetscStrrstr(a,b,&test);
721: if (test) {
722: PetscStrlen(a,&na);
723: PetscStrlen(b,&nb);
724: if (a+na-nb == test) *flg = PETSC_TRUE;
725: }
726: return(0);
727: }
731: /*@C
732: PetscStrbeginswith - Determines if a string begins with a certain string
734: Not Collective
736: Input Parameters:
737: + a - pointer to string
738: - b - string to beginwith
740: Output Parameter:
741: . flg - PETSC_TRUE or PETSC_FALSE
743: Notes: Not for use in Fortran
745: Level: intermediate
747: @*/
748: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
749: {
750: char *test;
754: *flg = PETSC_FALSE;
755: PetscStrrstr(a,b,&test);
756: if (test && (test == a)) *flg = PETSC_TRUE;
757: return(0);
758: }
763: /*@C
764: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
766: Not Collective
768: Input Parameters:
769: + a - pointer to string
770: - bs - strings to endwith (last entry must be null)
772: Output Parameter:
773: . cnt - the index of the string it ends with or 1+the last possible index
775: Notes: Not for use in Fortran
777: Level: intermediate
779: @*/
780: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
781: {
782: PetscBool flg;
786: *cnt = 0;
787: while (bs[*cnt]) {
788: PetscStrendswith(a,bs[*cnt],&flg);
789: if (flg) return(0);
790: *cnt += 1;
791: }
792: return(0);
793: }
797: /*@C
798: PetscStrrstr - Locates last occurance of string in another string
800: Not Collective
802: Input Parameters:
803: + a - pointer to string
804: - b - string to find
806: Output Parameter:
807: . tmp - location of occurance
809: Notes: Not for use in Fortran
811: Level: intermediate
813: @*/
814: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
815: {
816: const char *stmp = a, *ltmp = 0;
819: while (stmp) {
820: stmp = (char*)strstr(stmp,b);
821: if (stmp) {ltmp = stmp;stmp++;}
822: }
823: *tmp = (char*)ltmp;
824: return(0);
825: }
829: /*@C
830: PetscStrstr - Locates first occurance of string in another string
832: Not Collective
834: Input Parameters:
835: + haystack - string to search
836: - needle - string to find
838: Output Parameter:
839: . tmp - location of occurance, is a NULL if the string is not found
841: Notes: Not for use in Fortran
843: Level: intermediate
845: @*/
846: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
847: {
849: *tmp = (char*)strstr(haystack,needle);
850: return(0);
851: }
853: struct _p_PetscToken {char token;char *array;char *current;};
857: /*@C
858: PetscTokenFind - Locates next "token" in a string
860: Not Collective
862: Input Parameters:
863: . a - pointer to token
865: Output Parameter:
866: . result - location of occurance, NULL if not found
868: Notes:
870: This version is different from the system version in that
871: it allows you to pass a read-only string into the function.
873: This version also treats all characters etc. inside a double quote "
874: as a single token.
876: Not for use in Fortran
878: Level: intermediate
881: .seealso: PetscTokenCreate(), PetscTokenDestroy()
882: @*/
883: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
884: {
885: char *ptr = a->current,token;
888: *result = a->current;
889: if (ptr && !*ptr) {*result = 0;return(0);}
890: token = a->token;
891: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
892: while (ptr) {
893: if (*ptr == token) {
894: *ptr++ = 0;
895: while (*ptr == a->token) ptr++;
896: a->current = ptr;
897: break;
898: }
899: if (!*ptr) {
900: a->current = 0;
901: break;
902: }
903: ptr++;
904: }
905: return(0);
906: }
910: /*@C
911: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
913: Not Collective
915: Input Parameters:
916: + string - the string to look in
917: - token - the character to look for
919: Output Parameter:
920: . a - pointer to token
922: Notes:
924: This version is different from the system version in that
925: it allows you to pass a read-only string into the function.
927: Not for use in Fortran
929: Level: intermediate
931: .seealso: PetscTokenFind(), PetscTokenDestroy()
932: @*/
933: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
934: {
938: PetscNew(t);
939: PetscStrallocpy(a,&(*t)->array);
941: (*t)->current = (*t)->array;
942: (*t)->token = b;
943: return(0);
944: }
948: /*@C
949: PetscTokenDestroy - Destroys a PetscToken
951: Not Collective
953: Input Parameters:
954: . a - pointer to token
956: Level: intermediate
958: Notes: Not for use in Fortran
960: .seealso: PetscTokenCreate(), PetscTokenFind()
961: @*/
962: PetscErrorCode PetscTokenDestroy(PetscToken *a)
963: {
967: if (!*a) return(0);
968: PetscFree((*a)->array);
969: PetscFree(*a);
970: return(0);
971: }
976: /*@C
977: PetscGetPetscDir - Gets the directory PETSc is installed in
979: Not Collective
981: Output Parameter:
982: . dir - the directory
984: Level: developer
986: Notes: Not for use in Fortran
988: @*/
989: PetscErrorCode PetscGetPetscDir(const char *dir[])
990: {
992: *dir = PETSC_DIR;
993: return(0);
994: }
998: /*@C
999: PetscStrreplace - Replaces substrings in string with other substrings
1001: Not Collective
1003: Input Parameters:
1004: + comm - MPI_Comm of processors that are processing the string
1005: . aa - the string to look in
1006: . b - the resulting copy of a with replaced strings (b can be the same as a)
1007: - len - the length of b
1009: Notes:
1010: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1011: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1012: as well as any environmental variables.
1014: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1015: PETSc was built with and do not use environmental variables.
1017: Not for use in Fortran
1019: Level: intermediate
1021: @*/
1022: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1023: {
1025: int i = 0;
1026: size_t l,l1,l2,l3;
1027: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1028: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1029: const char *r[] = {0,0,0,0,0,0,0,0,0};
1030: PetscBool flag;
1033: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1034: if (aa == b) {
1035: PetscStrallocpy(aa,(char**)&a);
1036: }
1037: PetscMalloc1(len,&work);
1039: /* get values for replaced variables */
1040: PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1041: PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1042: PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1043: PetscMalloc1(256,&r[3]);
1044: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1045: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1046: PetscMalloc1(256,&r[6]);
1047: PetscMalloc1(256,&r[7]);
1048: PetscGetDisplay((char*)r[3],256);
1049: PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1050: PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1051: PetscGetUserName((char*)r[6],256);
1052: PetscGetHostName((char*)r[7],256);
1054: /* replace that are in environment */
1055: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1056: if (flag) {
1057: PetscFree(r[2]);
1058: PetscStrallocpy(env,(char**)&r[2]);
1059: }
1061: /* replace the requested strings */
1062: PetscStrncpy(b,a,len);
1063: while (s[i]) {
1064: PetscStrlen(s[i],&l);
1065: PetscStrstr(b,s[i],&par);
1066: while (par) {
1067: *par = 0;
1068: par += l;
1070: PetscStrlen(b,&l1);
1071: PetscStrlen(r[i],&l2);
1072: PetscStrlen(par,&l3);
1073: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1074: PetscStrcpy(work,b);
1075: PetscStrcat(work,r[i]);
1076: PetscStrcat(work,par);
1077: PetscStrncpy(b,work,len);
1078: PetscStrstr(b,s[i],&par);
1079: }
1080: i++;
1081: }
1082: i = 0;
1083: while (r[i]) {
1084: tfree = (char*)r[i];
1085: PetscFree(tfree);
1086: i++;
1087: }
1089: /* look for any other ${xxx} strings to replace from environmental variables */
1090: PetscStrstr(b,"${",&par);
1091: while (par) {
1092: *par = 0;
1093: par += 2;
1094: PetscStrcpy(work,b);
1095: PetscStrstr(par,"}",&epar);
1096: *epar = 0;
1097: epar += 1;
1098: PetscOptionsGetenv(comm,par,env,256,&flag);
1099: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1100: PetscStrcat(work,env);
1101: PetscStrcat(work,epar);
1102: PetscStrcpy(b,work);
1103: PetscStrstr(b,"${",&par);
1104: }
1105: PetscFree(work);
1106: if (aa == b) {
1107: PetscFree(a);
1108: }
1109: return(0);
1110: }
1114: /*@C
1115: PetscEListFind - searches list of strings for given string, using case insensitive matching
1117: Not Collective
1119: Input Parameters:
1120: + n - number of strings in
1121: . list - list of strings to search
1122: - str - string to look for, empty string "" accepts default (first entry in list)
1124: Output Parameters:
1125: + value - index of matching string (if found)
1126: - found - boolean indicating whether string was found (can be NULL)
1128: Notes:
1129: Not for use in Fortran
1131: Level: advanced
1132: @*/
1133: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1134: {
1136: PetscBool matched;
1137: PetscInt i;
1140: if (found) *found = PETSC_FALSE;
1141: for (i=0; i<n; i++) {
1142: PetscStrcasecmp(str,list[i],&matched);
1143: if (matched || !str[0]) {
1144: if (found) *found = PETSC_TRUE;
1145: *value = i;
1146: break;
1147: }
1148: }
1149: return(0);
1150: }
1154: /*@C
1155: PetscEListFind - searches enum list of strings for given string, using case insensitive matching
1157: Not Collective
1159: Input Parameters:
1160: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1161: - str - string to look for
1163: Output Parameters:
1164: + value - index of matching string (if found)
1165: - found - boolean indicating whether string was found (can be NULL)
1167: Notes:
1168: Not for use in Fortran
1170: Level: advanced
1171: @*/
1172: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1173: {
1175: PetscInt n = 0,evalue;
1176: PetscBool efound;
1179: 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");
1180: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1181: n -= 3; /* drop enum name, prefix, and null termination */
1182: PetscEListFind(n,enumlist,str,&evalue,&efound);
1183: if (efound) *value = (PetscEnum)evalue;
1184: if (found) *found = efound;
1185: return(0);
1186: }