1 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. 6 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 15 16 #undef __FUNCT__ 17 #define __FUNCT__ "PetscStrToArray" 18 /*@C 19 PetscStrToArray - Seperates a string by a charactor (for example ' ' or '\n') and creates an array of strings 20 21 Not Collective 22 23 Input Parameters: 24 + s - pointer to string 25 - sp - separator charactor 26 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 30 31 Level: intermediate 32 33 Notes: this may be called before PetscInitialize() or after PetscFinalize() 34 35 Not for use in Fortran 36 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() 39 40 .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate() 41 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; 47 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; 65 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 } 74 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; 80 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 } 91 92 #undef __FUNCT__ 93 #define __FUNCT__ "PetscStrToArrayDestroy" 94 /*@C 95 PetscStrToArrayDestroy - Frees array created with PetscStrToArray(). 96 97 Not Collective 98 99 Output Parameters: 100 + argc - the number of arguments 101 - args - the array of arguments 102 103 Level: intermediate 104 105 Concepts: command line arguments 106 107 Notes: This may be called before PetscInitialize() or after PetscFinalize() 108 109 Not for use in Fortran 110 111 .seealso: PetscStrToArray() 112 113 @*/ 114 PetscErrorCode PetscStrToArrayDestroy(int argc,char **args) 115 { 116 PetscInt i; 117 118 for (i=0; i<argc; i++) free(args[i]); 119 if (args) free(args); 120 return 0; 121 } 122 123 #undef __FUNCT__ 124 #define __FUNCT__ "PetscStrlen" 125 /*@C 126 PetscStrlen - Gets length of a string 127 128 Not Collective 129 130 Input Parameters: 131 . s - pointer to string 132 133 Output Parameter: 134 . len - length in bytes 135 136 Level: intermediate 137 138 Note: 139 This routine is analogous to strlen(). 140 141 Null string returns a length of zero 142 143 Not for use in Fortran 144 145 Concepts: string length 146 147 @*/ 148 PetscErrorCode PetscStrlen(const char s[],size_t *len) 149 { 150 PetscFunctionBegin; 151 if (!s) *len = 0; 152 else *len = strlen(s); 153 PetscFunctionReturn(0); 154 } 155 156 #undef __FUNCT__ 157 #define __FUNCT__ "PetscStrallocpy" 158 /*@C 159 PetscStrallocpy - Allocates space to hold a copy of a string then copies the string 160 161 Not Collective 162 163 Input Parameters: 164 . s - pointer to string 165 166 Output Parameter: 167 . t - the copied string 168 169 Level: intermediate 170 171 Note: 172 Null string returns a new null string 173 174 Not for use in Fortran 175 176 Concepts: string copy 177 178 @*/ 179 PetscErrorCode PetscStrallocpy(const char s[],char *t[]) 180 { 181 PetscErrorCode ierr; 182 size_t len; 183 char *tmp = 0; 184 185 PetscFunctionBegin; 186 if (s) { 187 ierr = PetscStrlen(s,&len);CHKERRQ(ierr); 188 ierr = PetscMalloc1((1+len),&tmp);CHKERRQ(ierr); 189 ierr = PetscStrcpy(tmp,s);CHKERRQ(ierr); 190 } 191 *t = tmp; 192 PetscFunctionReturn(0); 193 } 194 195 #undef __FUNCT__ 196 #define __FUNCT__ "PetscStrArrayallocpy" 197 /*@C 198 PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings 199 200 Not Collective 201 202 Input Parameters: 203 . s - pointer to array of strings (final string is a null) 204 205 Output Parameter: 206 . t - the copied array string 207 208 Level: intermediate 209 210 Note: 211 Not for use in Fortran 212 213 Concepts: string copy 214 215 .seealso: PetscStrallocpy() PetscStrArrayDestroy() 216 217 @*/ 218 PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t) 219 { 220 PetscErrorCode ierr; 221 PetscInt i,n = 0; 222 223 PetscFunctionBegin; 224 while (list[n++]) ; 225 ierr = PetscMalloc1((n+1),t);CHKERRQ(ierr); 226 for (i=0; i<n; i++) { 227 ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr); 228 } 229 (*t)[n] = NULL; 230 PetscFunctionReturn(0); 231 } 232 233 #undef __FUNCT__ 234 #define __FUNCT__ "PetscStrArrayDestroy" 235 /*@C 236 PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy(). 237 238 Not Collective 239 240 Output Parameters: 241 . list - array of strings 242 243 Level: intermediate 244 245 Concepts: command line arguments 246 247 Notes: Not for use in Fortran 248 249 .seealso: PetscStrArrayallocpy() 250 251 @*/ 252 PetscErrorCode PetscStrArrayDestroy(char ***list) 253 { 254 PetscInt n = 0; 255 PetscErrorCode ierr; 256 257 PetscFunctionBegin; 258 if (!*list) PetscFunctionReturn(0); 259 while ((*list)[n]) { 260 ierr = PetscFree((*list)[n]);CHKERRQ(ierr); 261 n++; 262 } 263 ierr = PetscFree(*list);CHKERRQ(ierr); 264 PetscFunctionReturn(0); 265 } 266 267 #undef __FUNCT__ 268 #define __FUNCT__ "PetscStrcpy" 269 /*@C 270 PetscStrcpy - Copies a string 271 272 Not Collective 273 274 Input Parameters: 275 . t - pointer to string 276 277 Output Parameter: 278 . s - the copied string 279 280 Level: intermediate 281 282 Notes: 283 Null string returns a string starting with zero 284 285 Not for use in Fortran 286 287 Concepts: string copy 288 289 .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat() 290 291 @*/ 292 293 PetscErrorCode PetscStrcpy(char s[],const char t[]) 294 { 295 PetscFunctionBegin; 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 PetscFunctionReturn(0); 300 } 301 302 #undef __FUNCT__ 303 #define __FUNCT__ "PetscStrncpy" 304 /*@C 305 PetscStrncpy - Copies a string up to a certain length 306 307 Not Collective 308 309 Input Parameters: 310 + t - pointer to string 311 - n - the length to copy 312 313 Output Parameter: 314 . s - the copied string 315 316 Level: intermediate 317 318 Note: 319 Null string returns a string starting with zero 320 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. 324 325 Concepts: string copy 326 327 .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat() 328 329 @*/ 330 PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n) 331 { 332 PetscFunctionBegin; 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); 336 s[n-1] = '\0'; 337 } else if (s) s[0] = 0; 338 PetscFunctionReturn(0); 339 } 340 341 #undef __FUNCT__ 342 #define __FUNCT__ "PetscStrcat" 343 /*@C 344 PetscStrcat - Concatenates a string onto a given string 345 346 Not Collective 347 348 Input Parameters: 349 + s - string to be added to 350 - t - pointer to string to be added to end 351 352 Level: intermediate 353 354 Notes: Not for use in Fortran 355 356 Concepts: string copy 357 358 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat() 359 360 @*/ 361 PetscErrorCode PetscStrcat(char s[],const char t[]) 362 { 363 PetscFunctionBegin; 364 if (!t) PetscFunctionReturn(0); 365 strcat(s,t); 366 PetscFunctionReturn(0); 367 } 368 369 #undef __FUNCT__ 370 #define __FUNCT__ "PetscStrncat" 371 /*@C 372 PetscStrncat - Concatenates a string onto a given string, up to a given length 373 374 Not Collective 375 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 380 381 Level: intermediate 382 383 Notes: Not for use in Fortran 384 385 Concepts: string copy 386 387 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat() 388 389 @*/ 390 PetscErrorCode PetscStrncat(char s[],const char t[],size_t n) 391 { 392 PetscFunctionBegin; 393 strncat(s,t,n); 394 PetscFunctionReturn(0); 395 } 396 397 #undef __FUNCT__ 398 #define __FUNCT__ "PetscStrcmpNoError" 399 /* 400 Only to be used with PetscCheck__FUNCT__()! 401 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; 407 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 } 416 417 #undef __FUNCT__ 418 #define __FUNCT__ "PetscStrcmp" 419 /*@C 420 PetscStrcmp - Compares two strings, 421 422 Not Collective 423 424 Input Parameters: 425 + a - pointer to string first string 426 - b - pointer to second string 427 428 Output Parameter: 429 . flg - PETSC_TRUE if the two strings are equal 430 431 Level: intermediate 432 433 Notes: Not for use in Fortran 434 435 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp() 436 437 @*/ 438 PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg) 439 { 440 int c; 441 442 PetscFunctionBegin; 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 PetscFunctionReturn(0); 451 } 452 453 #undef __FUNCT__ 454 #define __FUNCT__ "PetscStrgrt" 455 /*@C 456 PetscStrgrt - If first string is greater than the second 457 458 Not Collective 459 460 Input Parameters: 461 + a - pointer to first string 462 - b - pointer to second string 463 464 Output Parameter: 465 . flg - if the first string is greater 466 467 Notes: 468 Null arguments are ok, a null string is considered smaller than 469 all others 470 471 Not for use in Fortran 472 473 Level: intermediate 474 475 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp() 476 477 @*/ 478 PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t) 479 { 480 int c; 481 482 PetscFunctionBegin; 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 PetscFunctionReturn(0); 492 } 493 494 #undef __FUNCT__ 495 #define __FUNCT__ "PetscStrcasecmp" 496 /*@C 497 PetscStrcasecmp - Returns true if the two strings are the same 498 except possibly for case. 499 500 Not Collective 501 502 Input Parameters: 503 + a - pointer to first string 504 - b - pointer to second string 505 506 Output Parameter: 507 . flg - if the two strings are the same 508 509 Notes: 510 Null arguments are ok 511 512 Not for use in Fortran 513 514 Level: intermediate 515 516 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt() 517 518 @*/ 519 PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t) 520 { 521 int c; 522 523 PetscFunctionBegin; 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; 533 PetscErrorCode ierr; 534 ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr); 535 ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr); 536 ierr = PetscStrtolower(aa);CHKERRQ(ierr); 537 ierr = PetscStrtolower(bb);CHKERRQ(ierr); 538 ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr); 539 ierr = PetscFree(aa);CHKERRQ(ierr); 540 ierr = PetscFree(bb);CHKERRQ(ierr); 541 PetscFunctionReturn(0); 542 } 543 #endif 544 if (!c) *t = PETSC_TRUE; 545 else *t = PETSC_FALSE; 546 PetscFunctionReturn(0); 547 } 548 549 550 551 #undef __FUNCT__ 552 #define __FUNCT__ "PetscStrncmp" 553 /*@C 554 PetscStrncmp - Compares two strings, up to a certain length 555 556 Not Collective 557 558 Input Parameters: 559 + a - pointer to first string 560 . b - pointer to second string 561 - n - length to compare up to 562 563 Output Parameter: 564 . t - if the two strings are equal 565 566 Level: intermediate 567 568 Notes: Not for use in Fortran 569 570 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp() 571 572 @*/ 573 PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t) 574 { 575 int c; 576 577 PetscFunctionBegin; 578 c = strncmp(a,b,n); 579 if (!c) *t = PETSC_TRUE; 580 else *t = PETSC_FALSE; 581 PetscFunctionReturn(0); 582 } 583 584 #undef __FUNCT__ 585 #define __FUNCT__ "PetscStrchr" 586 /*@C 587 PetscStrchr - Locates first occurance of a character in a string 588 589 Not Collective 590 591 Input Parameters: 592 + a - pointer to string 593 - b - character 594 595 Output Parameter: 596 . c - location of occurance, NULL if not found 597 598 Level: intermediate 599 600 Notes: Not for use in Fortran 601 602 @*/ 603 PetscErrorCode PetscStrchr(const char a[],char b,char *c[]) 604 { 605 PetscFunctionBegin; 606 *c = (char*)strchr(a,b); 607 PetscFunctionReturn(0); 608 } 609 610 #undef __FUNCT__ 611 #define __FUNCT__ "PetscStrrchr" 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 615 616 Not Collective 617 618 Input Parameters: 619 + a - pointer to string 620 - b - character 621 622 Output Parameter: 623 . tmp - location of occurance, a if not found 624 625 Level: intermediate 626 627 Notes: Not for use in Fortran 628 629 @*/ 630 PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[]) 631 { 632 PetscFunctionBegin; 633 *tmp = (char*)strrchr(a,b); 634 if (!*tmp) *tmp = (char*)a; 635 else *tmp = *tmp + 1; 636 PetscFunctionReturn(0); 637 } 638 639 #undef __FUNCT__ 640 #define __FUNCT__ "PetscStrtolower" 641 /*@C 642 PetscStrtolower - Converts string to lower case 643 644 Not Collective 645 646 Input Parameters: 647 . a - pointer to string 648 649 Level: intermediate 650 651 Notes: Not for use in Fortran 652 653 @*/ 654 PetscErrorCode PetscStrtolower(char a[]) 655 { 656 PetscFunctionBegin; 657 while (*a) { 658 if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A'; 659 a++; 660 } 661 PetscFunctionReturn(0); 662 } 663 664 #undef __FUNCT__ 665 #define __FUNCT__ "PetscStrtoupper" 666 /*@C 667 PetscStrtolower - Converts string to upper case 668 669 Not Collective 670 671 Input Parameters: 672 . a - pointer to string 673 674 Level: intermediate 675 676 Notes: Not for use in Fortran 677 678 @*/ 679 PetscErrorCode PetscStrtoupper(char a[]) 680 { 681 PetscFunctionBegin; 682 while (*a) { 683 if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a'; 684 a++; 685 } 686 PetscFunctionReturn(0); 687 } 688 689 #undef __FUNCT__ 690 #define __FUNCT__ "PetscStrendswith" 691 /*@C 692 PetscStrendswith - Determines if a string ends with a certain string 693 694 Not Collective 695 696 Input Parameters: 697 + a - pointer to string 698 - b - string to endwith 699 700 Output Parameter: 701 . flg - PETSC_TRUE or PETSC_FALSE 702 703 Notes: Not for use in Fortran 704 705 Level: intermediate 706 707 @*/ 708 PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg) 709 { 710 char *test; 711 PetscErrorCode ierr; 712 size_t na,nb; 713 714 PetscFunctionBegin; 715 *flg = PETSC_FALSE; 716 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 717 if (test) { 718 ierr = PetscStrlen(a,&na);CHKERRQ(ierr); 719 ierr = PetscStrlen(b,&nb);CHKERRQ(ierr); 720 if (a+na-nb == test) *flg = PETSC_TRUE; 721 } 722 PetscFunctionReturn(0); 723 } 724 725 #undef __FUNCT__ 726 #define __FUNCT__ "PetscStrbeginswith" 727 /*@C 728 PetscStrbeginswith - Determines if a string begins with a certain string 729 730 Not Collective 731 732 Input Parameters: 733 + a - pointer to string 734 - b - string to beginwith 735 736 Output Parameter: 737 . flg - PETSC_TRUE or PETSC_FALSE 738 739 Notes: Not for use in Fortran 740 741 Level: intermediate 742 743 @*/ 744 PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg) 745 { 746 char *test; 747 PetscErrorCode ierr; 748 749 PetscFunctionBegin; 750 *flg = PETSC_FALSE; 751 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 752 if (test && (test == a)) *flg = PETSC_TRUE; 753 PetscFunctionReturn(0); 754 } 755 756 757 #undef __FUNCT__ 758 #define __FUNCT__ "PetscStrendswithwhich" 759 /*@C 760 PetscStrendswithwhich - Determines if a string ends with one of several possible strings 761 762 Not Collective 763 764 Input Parameters: 765 + a - pointer to string 766 - bs - strings to endwith (last entry must be null) 767 768 Output Parameter: 769 . cnt - the index of the string it ends with or 1+the last possible index 770 771 Notes: Not for use in Fortran 772 773 Level: intermediate 774 775 @*/ 776 PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt) 777 { 778 PetscBool flg; 779 PetscErrorCode ierr; 780 781 PetscFunctionBegin; 782 *cnt = 0; 783 while (bs[*cnt]) { 784 ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr); 785 if (flg) PetscFunctionReturn(0); 786 *cnt += 1; 787 } 788 PetscFunctionReturn(0); 789 } 790 791 #undef __FUNCT__ 792 #define __FUNCT__ "PetscStrrstr" 793 /*@C 794 PetscStrrstr - Locates last occurance of string in another string 795 796 Not Collective 797 798 Input Parameters: 799 + a - pointer to string 800 - b - string to find 801 802 Output Parameter: 803 . tmp - location of occurance 804 805 Notes: Not for use in Fortran 806 807 Level: intermediate 808 809 @*/ 810 PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[]) 811 { 812 const char *stmp = a, *ltmp = 0; 813 814 PetscFunctionBegin; 815 while (stmp) { 816 stmp = (char*)strstr(stmp,b); 817 if (stmp) {ltmp = stmp;stmp++;} 818 } 819 *tmp = (char*)ltmp; 820 PetscFunctionReturn(0); 821 } 822 823 #undef __FUNCT__ 824 #define __FUNCT__ "PetscStrstr" 825 /*@C 826 PetscStrstr - Locates first occurance of string in another string 827 828 Not Collective 829 830 Input Parameters: 831 + haystack - string to search 832 - needle - string to find 833 834 Output Parameter: 835 . tmp - location of occurance, is a NULL if the string is not found 836 837 Notes: Not for use in Fortran 838 839 Level: intermediate 840 841 @*/ 842 PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[]) 843 { 844 PetscFunctionBegin; 845 *tmp = (char*)strstr(haystack,needle); 846 PetscFunctionReturn(0); 847 } 848 849 struct _p_PetscToken {char token;char *array;char *current;}; 850 851 #undef __FUNCT__ 852 #define __FUNCT__ "PetscTokenFind" 853 /*@C 854 PetscTokenFind - Locates next "token" in a string 855 856 Not Collective 857 858 Input Parameters: 859 . a - pointer to token 860 861 Output Parameter: 862 . result - location of occurance, NULL if not found 863 864 Notes: 865 866 This version is different from the system version in that 867 it allows you to pass a read-only string into the function. 868 869 This version also treats all characters etc. inside a double quote " 870 as a single token. 871 872 Not for use in Fortran 873 874 Level: intermediate 875 876 877 .seealso: PetscTokenCreate(), PetscTokenDestroy() 878 @*/ 879 PetscErrorCode PetscTokenFind(PetscToken a,char *result[]) 880 { 881 char *ptr = a->current,token; 882 883 PetscFunctionBegin; 884 *result = a->current; 885 if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(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 PetscFunctionReturn(0); 902 } 903 904 #undef __FUNCT__ 905 #define __FUNCT__ "PetscTokenCreate" 906 /*@C 907 PetscTokenCreate - Creates a PetscToken used to find tokens in a string 908 909 Not Collective 910 911 Input Parameters: 912 + string - the string to look in 913 - token - the character to look for 914 915 Output Parameter: 916 . a - pointer to token 917 918 Notes: 919 920 This version is different from the system version in that 921 it allows you to pass a read-only string into the function. 922 923 Not for use in Fortran 924 925 Level: intermediate 926 927 .seealso: PetscTokenFind(), PetscTokenDestroy() 928 @*/ 929 PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t) 930 { 931 PetscErrorCode ierr; 932 933 PetscFunctionBegin; 934 ierr = PetscNew(t);CHKERRQ(ierr); 935 ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr); 936 937 (*t)->current = (*t)->array; 938 (*t)->token = b; 939 PetscFunctionReturn(0); 940 } 941 942 #undef __FUNCT__ 943 #define __FUNCT__ "PetscTokenDestroy" 944 /*@C 945 PetscTokenDestroy - Destroys a PetscToken 946 947 Not Collective 948 949 Input Parameters: 950 . a - pointer to token 951 952 Level: intermediate 953 954 Notes: Not for use in Fortran 955 956 .seealso: PetscTokenCreate(), PetscTokenFind() 957 @*/ 958 PetscErrorCode PetscTokenDestroy(PetscToken *a) 959 { 960 PetscErrorCode ierr; 961 962 PetscFunctionBegin; 963 if (!*a) PetscFunctionReturn(0); 964 ierr = PetscFree((*a)->array);CHKERRQ(ierr); 965 ierr = PetscFree(*a);CHKERRQ(ierr); 966 PetscFunctionReturn(0); 967 } 968 969 970 #undef __FUNCT__ 971 #define __FUNCT__ "PetscGetPetscDir" 972 /*@C 973 PetscGetPetscDir - Gets the directory PETSc is installed in 974 975 Not Collective 976 977 Output Parameter: 978 . dir - the directory 979 980 Level: developer 981 982 Notes: Not for use in Fortran 983 984 @*/ 985 PetscErrorCode PetscGetPetscDir(const char *dir[]) 986 { 987 PetscFunctionBegin; 988 *dir = PETSC_DIR; 989 PetscFunctionReturn(0); 990 } 991 992 #undef __FUNCT__ 993 #define __FUNCT__ "PetscStrreplace" 994 /*@C 995 PetscStrreplace - Replaces substrings in string with other substrings 996 997 Not Collective 998 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 1004 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. 1009 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. 1012 1013 Not for use in Fortran 1014 1015 Level: intermediate 1016 1017 @*/ 1018 PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len) 1019 { 1020 PetscErrorCode ierr; 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; 1027 1028 PetscFunctionBegin; 1029 if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull"); 1030 if (aa == b) { 1031 ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr); 1032 } 1033 ierr = PetscMalloc1(len,&work);CHKERRQ(ierr); 1034 1035 /* get values for replaced variables */ 1036 ierr = PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);CHKERRQ(ierr); 1037 ierr = PetscStrallocpy(PETSC_DIR,(char**)&r[1]);CHKERRQ(ierr); 1038 ierr = PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);CHKERRQ(ierr); 1039 ierr = PetscMalloc1(256,&r[3]);CHKERRQ(ierr); 1040 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr); 1041 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr); 1042 ierr = PetscMalloc1(256,&r[6]);CHKERRQ(ierr); 1043 ierr = PetscMalloc1(256,&r[7]);CHKERRQ(ierr); 1044 ierr = PetscGetDisplay((char*)r[3],256);CHKERRQ(ierr); 1045 ierr = PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1046 ierr = PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1047 ierr = PetscGetUserName((char*)r[6],256);CHKERRQ(ierr); 1048 ierr = PetscGetHostName((char*)r[7],256);CHKERRQ(ierr); 1049 1050 /* replace that are in environment */ 1051 ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr); 1052 if (flag) { 1053 ierr = PetscFree(r[2]);CHKERRQ(ierr); 1054 ierr = PetscStrallocpy(env,(char**)&r[2]);CHKERRQ(ierr); 1055 } 1056 1057 /* replace the requested strings */ 1058 ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr); 1059 while (s[i]) { 1060 ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr); 1061 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1062 while (par) { 1063 *par = 0; 1064 par += l; 1065 1066 ierr = PetscStrlen(b,&l1);CHKERRQ(ierr); 1067 ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr); 1068 ierr = PetscStrlen(par,&l3);CHKERRQ(ierr); 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 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1071 ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr); 1072 ierr = PetscStrcat(work,par);CHKERRQ(ierr); 1073 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr); 1074 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1075 } 1076 i++; 1077 } 1078 i = 0; 1079 while (r[i]) { 1080 tfree = (char*)r[i]; 1081 ierr = PetscFree(tfree);CHKERRQ(ierr); 1082 i++; 1083 } 1084 1085 /* look for any other ${xxx} strings to replace from environmental variables */ 1086 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1087 while (par) { 1088 *par = 0; 1089 par += 2; 1090 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1091 ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr); 1092 *epar = 0; 1093 epar += 1; 1094 ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr); 1095 if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par); 1096 ierr = PetscStrcat(work,env);CHKERRQ(ierr); 1097 ierr = PetscStrcat(work,epar);CHKERRQ(ierr); 1098 ierr = PetscStrcpy(b,work);CHKERRQ(ierr); 1099 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1100 } 1101 ierr = PetscFree(work);CHKERRQ(ierr); 1102 if (aa == b) { 1103 ierr = PetscFree(a);CHKERRQ(ierr); 1104 } 1105 PetscFunctionReturn(0); 1106 } 1107 1108 #undef __FUNCT__ 1109 #define __FUNCT__ "PetscEListFind" 1110 /*@C 1111 PetscEListFind - searches list of strings for given string, using case insensitive matching 1112 1113 Not Collective 1114 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) 1119 1120 Output Parameters: 1121 + value - index of matching string (if found) 1122 - found - boolean indicating whether string was found (can be NULL) 1123 1124 Notes: 1125 Not for use in Fortran 1126 1127 Level: advanced 1128 @*/ 1129 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found) 1130 { 1131 PetscErrorCode ierr; 1132 PetscBool matched; 1133 PetscInt i; 1134 1135 PetscFunctionBegin; 1136 if (found) *found = PETSC_FALSE; 1137 for (i=0; i<n; i++) { 1138 ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr); 1139 if (matched || !str[0]) { 1140 if (found) *found = PETSC_TRUE; 1141 *value = i; 1142 break; 1143 } 1144 } 1145 PetscFunctionReturn(0); 1146 } 1147 1148 #undef __FUNCT__ 1149 #define __FUNCT__ "PetscEnumFind" 1150 /*@C 1151 PetscEListFind - searches enum list of strings for given string, using case insensitive matching 1152 1153 Not Collective 1154 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 1158 1159 Output Parameters: 1160 + value - index of matching string (if found) 1161 - found - boolean indicating whether string was found (can be NULL) 1162 1163 Notes: 1164 Not for use in Fortran 1165 1166 Level: advanced 1167 @*/ 1168 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found) 1169 { 1170 PetscErrorCode ierr; 1171 PetscInt n,evalue; 1172 PetscBool efound; 1173 1174 PetscFunctionBegin; 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 ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr); 1181 if (efound) *value = (PetscEnum)evalue; 1182 if (found) *found = efound; 1183 PetscFunctionReturn(0); 1184 } 1185