Actual source code: str.c
petsc-3.4.5 2014-06-29
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: }