Changeset 5510
- Timestamp:
- Jan 28, 2025, 7:02:29 PM (2 days ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/misc/strings_mod.f90 (modified) (44 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/misc/strings_mod.f90
r5353 r5510 138 138 END SUBROUTINE msg_m 139 139 !============================================================================================================================== 140 LOGICALFUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)140 FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l) 141 141 IMPLICIT NONE 142 142 CHARACTER(LEN=*), INTENT(IN) :: str … … 144 144 LOGICAL, OPTIONAL, INTENT(IN) :: ll 145 145 INTEGER, OPTIONAL, INTENT(IN) :: unit 146 LOGICAL :: l 146 147 !------------------------------------------------------------------------------------------------------------------------------ 147 148 CHARACTER(LEN=maxlen) :: subn … … 153 154 END FUNCTION fmsg_1 154 155 !============================================================================================================================== 155 LOGICALFUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)156 FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l) 156 157 IMPLICIT NONE 157 158 CHARACTER(LEN=*), INTENT(IN) :: str(:) … … 160 161 INTEGER, OPTIONAL, INTENT(IN) :: unit 161 162 INTEGER, OPTIONAL, INTENT(IN) :: nmax 163 LOGICAL :: l 162 164 !------------------------------------------------------------------------------------------------------------------------------ 163 165 CHARACTER(LEN=maxlen) :: subn … … 175 177 !=== Lower/upper case conversion function. ==================================================================================== 176 178 !============================================================================================================================== 177 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION strLower(str) RESULT(out)179 ELEMENTAL FUNCTION strLower(str) RESULT(out) 178 180 IMPLICIT NONE 179 181 CHARACTER(LEN=*), INTENT(IN) :: str 180 182 INTEGER :: k 183 CHARACTER(LEN=maxlen) :: out 181 184 out = str 182 185 DO k=1,LEN_TRIM(str) … … 185 188 END FUNCTION strLower 186 189 !============================================================================================================================== 187 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION strUpper(str) RESULT(out)190 ELEMENTAL FUNCTION strUpper(str) RESULT(out) 188 191 IMPLICIT NONE 189 192 CHARACTER(LEN=*), INTENT(IN) :: str 190 193 INTEGER :: k 194 CHARACTER(LEN=maxlen) :: out 191 195 out = str 192 196 DO k=1,LEN_TRIM(str) … … 203 207 !=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================ 204 208 !============================================================================================================================== 205 CHARACTER(LEN=maxlen)FUNCTION strHead_1(str, sep, lBackward) RESULT(out)209 FUNCTION strHead_1(str, sep, lBackward) RESULT(out) 206 210 IMPLICIT NONE 207 211 CHARACTER(LEN=*), INTENT(IN) :: str 208 212 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 209 213 LOGICAL, OPTIONAL, INTENT(IN) :: lBackward 214 CHARACTER(LEN=maxlen) :: out 210 215 !------------------------------------------------------------------------------------------------------------------------------ 211 216 IF(PRESENT(sep)) THEN … … 241 246 !=== * strTail(str, '_', .TRUE.) = 'c' ${str##*$sep} ================ 242 247 !============================================================================================================================== 243 CHARACTER(LEN=maxlen)FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)248 FUNCTION strTail_1(str, sep, lBackWard) RESULT(out) 244 249 IMPLICIT NONE 245 250 CHARACTER(LEN=*), INTENT(IN) :: str 246 251 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 247 252 LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard 253 CHARACTER(LEN=maxlen) :: out 248 254 !------------------------------------------------------------------------------------------------------------------------------ 249 255 IF(PRESENT(sep)) THEN … … 406 412 !=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0 ============================ 407 413 !============================================================================================================================== 408 INTEGERFUNCTION strIdx_1(str, s) RESULT(out)414 FUNCTION strIdx_1(str, s) RESULT(out) 409 415 IMPLICIT NONE 410 416 CHARACTER(LEN=*), INTENT(IN) :: str(:), s 417 INTEGER :: out 411 418 DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO 412 419 IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0 … … 491 498 !=== * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER 492 499 !============================================================================================================================== 493 LOGICALFUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)500 FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr) 494 501 IMPLICIT NONE 495 502 CHARACTER(LEN=*), INTENT(IN) :: rawList !--- String in which delimiters have to be identified … … 498 505 INTEGER, INTENT(OUT) :: idx !--- Index of the first identified delimiter in "rawList" 499 506 INTEGER, INTENT(OUT) :: idel !--- Index of the identified delimiter (0 if idx==0) 500 LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation 507 LOGICAL, OPTIONAL, INTENT(IN) :: lSc 508 LOGICAL :: lerr 509 !--- Care about nbs with front sign or in scient. notation 501 510 !------------------------------------------------------------------------------------------------------------------------------ 502 511 INTEGER :: idx0 !--- Used to display an identified non-numeric string … … 526 535 527 536 !------------------------------------------------------------------------------------------------------------------------------ 528 INTEGERFUNCTION strIdx1(str, del, ib, id) RESULT(i)537 FUNCTION strIdx1(str, del, ib, id) RESULT(i) 529 538 !--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib". 530 539 !--- "id" is the index in "del(:)" of the first delimiter found. … … 533 542 INTEGER, INTENT(IN) :: ib 534 543 INTEGER, INTENT(OUT) :: id 544 INTEGER :: i 535 545 !------------------------------------------------------------------------------------------------------------------------------ 536 546 DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO … … 545 555 !=== Count the number of elements separated by "delimiter" in list "rawList". ================================================= 546 556 !============================================================================================================================== 547 LOGICALFUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)557 FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr) 548 558 IMPLICIT NONE 549 559 CHARACTER(LEN=*), INTENT(IN) :: rawList … … 551 561 INTEGER, INTENT(OUT) :: nb 552 562 LOGICAL, OPTIONAL, INTENT(IN) :: lSc 563 LOGICAL :: lerr 553 564 !------------------------------------------------------------------------------------------------------------------------------ 554 565 LOGICAL :: ll … … 557 568 END FUNCTION strCount_11 558 569 !============================================================================================================================== 559 LOGICALFUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)570 FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr) 560 571 IMPLICIT NONE 561 572 CHARACTER(LEN=*), INTENT(IN) :: rawList(:) … … 563 574 INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:) 564 575 LOGICAL, OPTIONAL, INTENT(IN) :: lSc 576 LOGICAL :: lerr 565 577 !------------------------------------------------------------------------------------------------------------------------------ 566 578 LOGICAL :: ll … … 574 586 END FUNCTION strCount_m1 575 587 !============================================================================================================================== 576 LOGICALFUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)588 FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr) 577 589 IMPLICIT NONE 578 590 CHARACTER(LEN=*), INTENT(IN) :: rawList … … 584 596 LOGICAL :: ll 585 597 CHARACTER(LEN=1024) :: r 598 LOGICAL :: lerr 599 586 600 lerr = .FALSE. 587 601 ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc … … 605 619 !=== Corresponding "vals" remains empty if the element does not contain "=" sign. ==================================== 606 620 !============================================================================================================================== 607 LOGICALFUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)621 FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr) 608 622 IMPLICIT NONE 609 623 CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter … … 611 625 INTEGER, OPTIONAL, INTENT(OUT) :: n 612 626 CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:) 627 LOGICAL :: lerr 613 628 !------------------------------------------------------------------------------------------------------------------------------ 614 629 CHARACTER(LEN=1024) :: r … … 625 640 626 641 !------------------------------------------------------------------------------------------------------------------------------ 627 INTEGERFUNCTION countK() RESULT(nkeys)642 FUNCTION countK() RESULT(nkeys) 628 643 !--- Get the number of elements after parsing. 629 644 IMPLICIT NONE 645 INTEGER :: nkeys 630 646 !------------------------------------------------------------------------------------------------------------------------------ 631 647 INTEGER :: ib, ie, nl … … 680 696 END FUNCTION strParse 681 697 !============================================================================================================================== 682 LOGICALFUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)698 FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr) 683 699 IMPLICIT NONE 684 700 CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter(:) … … 688 704 LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Take care about numbers in scientific notation 689 705 INTEGER, OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:) !--- Indexes of the separators in "delimiter(:)" vector 706 LOGICAL :: lerr 690 707 !------------------------------------------------------------------------------------------------------------------------------ 691 708 CHARACTER(LEN=1024) :: r … … 1085 1102 !=== higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table. 1086 1103 !============================================================================================================================== 1087 LOGICALFUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)1104 FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr) 1088 1105 IMPLICIT NONE 1089 1106 CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r … … 1098 1115 INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen) 1099 1116 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name 1117 LOGICAL :: lerr 1100 1118 !------------------------------------------------------------------------------------------------------------------------------ 1101 1119 CHARACTER(LEN=2048) :: row … … 1194 1212 1195 1213 !============================================================================================================================== 1196 LOGICALFUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)1214 FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr) 1197 1215 IMPLICIT NONE 1198 1216 INTEGER, INTENT(IN) :: unt !--- Output unit … … 1204 1222 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals 1205 1223 LOGICAL, OPTIONAL, INTENT(IN) :: llast !--- Last variable: no final ',' 1224 LOGICAL :: lerr 1206 1225 !------------------------------------------------------------------------------------------------------------------------------ 1207 1226 CHARACTER(LEN=maxlen) :: rFm, el … … 1277 1296 1278 1297 !============================================================================================================================== 1279 LOGICALFUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)1298 FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr) 1280 1299 IMPLICIT NONE 1281 1300 ! Display outliers list in tables … … 1289 1308 INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1) 1290 1309 INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout) 1310 LOGICAL :: lerr 1291 1311 !------------------------------------------------------------------------------------------------------------------------------ 1292 1312 CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:) … … 1356 1376 END FUNCTION dispOutliers_1 1357 1377 !============================================================================================================================== 1358 LOGICALFUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)1378 FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr) 1359 1379 IMPLICIT NONE 1360 1380 ! Display outliers list in tables … … 1368 1388 INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1) 1369 1389 INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout) 1390 LOGICAL :: lerr 1370 1391 !------------------------------------------------------------------------------------------------------------------------------ 1371 1392 CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf … … 1414 1435 !=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ==================== 1415 1436 !============================================================================================================================== 1416 LOGICALFUNCTION reduceExpr_1(str, val) RESULT(lerr)1437 FUNCTION reduceExpr_1(str, val) RESULT(lerr) 1417 1438 IMPLICIT NONE 1418 1439 CHARACTER(LEN=*), INTENT(IN) :: str 1419 1440 CHARACTER(LEN=maxlen), INTENT(OUT) :: val 1441 LOGICAL :: lerr 1420 1442 !------------------------------------------------------------------------------------------------------------------------------ 1421 1443 CHARACTER(LEN=maxlen) :: v … … 1464 1486 !=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ============== 1465 1487 !============================================================================================================================== 1466 LOGICALFUNCTION reduceExpr_basic(str, val) RESULT(lerr)1488 FUNCTION reduceExpr_basic(str, val) RESULT(lerr) 1467 1489 IMPLICIT NONE 1468 1490 CHARACTER(LEN=*), INTENT(IN) :: str … … 1472 1494 CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:) 1473 1495 CHARACTER(LEN=1), ALLOCATABLE :: op(:) 1496 LOGICAL :: lerr 1474 1497 !------------------------------------------------------------------------------------------------------------------------------ 1475 1498 CHARACTER(LEN=1024) :: s … … 1524 1547 !=== Check whether a string is a number or not ================================================================================ 1525 1548 !============================================================================================================================== 1526 ELEMENTAL LOGICALFUNCTION is_numeric(str) RESULT(out)1549 ELEMENTAL FUNCTION is_numeric(str) RESULT(out) 1527 1550 IMPLICIT NONE 1528 1551 CHARACTER(LEN=*), INTENT(IN) :: str … … 1530 1553 INTEGER :: e 1531 1554 CHARACTER(LEN=12) :: fmt 1555 LOGICAL :: out 1556 1532 1557 IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF 1533 1558 WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str) … … 1541 1566 !=== Convert a string into a logical/integer integer or an integer/real into a string ========================================= 1542 1567 !============================================================================================================================== 1543 ELEMENTAL INTEGERFUNCTION str2bool(str) RESULT(out) !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean1568 ELEMENTAL FUNCTION str2bool(str) RESULT(out) !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean 1544 1569 IMPLICIT NONE 1545 1570 CHARACTER(LEN=*), INTENT(IN) :: str 1546 1571 INTEGER :: ierr 1547 1572 LOGICAL :: lout 1573 INTEGER :: out 1574 1548 1575 READ(str,*,IOSTAT=ierr) lout 1576 1549 1577 out = -HUGE(1) 1550 1578 IF(ierr /= 0) THEN … … 1556 1584 END FUNCTION str2bool 1557 1585 !============================================================================================================================== 1558 ELEMENTAL INTEGERFUNCTION str2int(str) RESULT(out)1586 ELEMENTAL FUNCTION str2int(str) RESULT(out) 1559 1587 IMPLICIT NONE 1560 1588 CHARACTER(LEN=*), INTENT(IN) :: str 1561 1589 INTEGER :: ierr 1590 INTEGER :: out 1591 1562 1592 READ(str,*,IOSTAT=ierr) out 1563 1593 IF(ierr/=0) out = -HUGE(1) 1564 1594 END FUNCTION str2int 1565 1595 !============================================================================================================================== 1566 ELEMENTAL REALFUNCTION str2real(str) RESULT(out)1596 ELEMENTAL FUNCTION str2real(str) RESULT(out) 1567 1597 IMPLICIT NONE 1568 1598 CHARACTER(LEN=*), INTENT(IN) :: str 1569 1599 INTEGER :: ierr 1600 REAL :: out 1601 1570 1602 READ(str,*,IOSTAT=ierr) out 1571 1603 IF(ierr/=0) out = -HUGE(1.) 1572 1604 END FUNCTION str2real 1573 1605 !============================================================================================================================== 1574 ELEMENTAL DOUBLE PRECISIONFUNCTION str2dble(str) RESULT(out)1606 ELEMENTAL FUNCTION str2dble(str) RESULT(out) 1575 1607 IMPLICIT NONE 1576 1608 CHARACTER(LEN=*), INTENT(IN) :: str 1577 1609 INTEGER :: ierr 1610 DOUBLE PRECISION :: out 1611 1578 1612 READ(str,*,IOSTAT=ierr) out 1579 1613 IF(ierr/=0) out = -HUGE(1.d0) 1580 1614 END FUNCTION str2dble 1581 1615 !============================================================================================================================== 1582 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION bool2str(b) RESULT(out)1616 ELEMENTAL FUNCTION bool2str(b) RESULT(out) 1583 1617 IMPLICIT NONE 1584 1618 LOGICAL, INTENT(IN) :: b 1619 CHARACTER(LEN=maxlen) :: out 1585 1620 WRITE(out,*)b 1586 1621 out = ADJUSTL(out) 1587 1622 END FUNCTION bool2str 1588 1623 !============================================================================================================================== 1589 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION int2str(i, nDigits) RESULT(out)1624 ELEMENTAL FUNCTION int2str(i, nDigits) RESULT(out) 1590 1625 IMPLICIT NONE 1591 1626 INTEGER, INTENT(IN) :: i 1592 1627 INTEGER, OPTIONAL, INTENT(IN) :: nDigits 1628 CHARACTER(LEN=maxlen) :: out 1593 1629 !------------------------------------------------------------------------------------------------------------------------------ 1594 1630 WRITE(out,*)i … … 1598 1634 END FUNCTION int2str 1599 1635 !============================================================================================================================== 1600 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION real2str(r,fmt) RESULT(out)1636 ELEMENTAL FUNCTION real2str(r,fmt) RESULT(out) 1601 1637 IMPLICIT NONE 1602 1638 REAL, INTENT(IN) :: r 1603 1639 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt 1640 CHARACTER(LEN=maxlen) :: out 1604 1641 !------------------------------------------------------------------------------------------------------------------------------ 1605 1642 IF( PRESENT(fmt)) WRITE(out,fmt)r … … 1608 1645 END FUNCTION real2str 1609 1646 !============================================================================================================================== 1610 ELEMENTAL CHARACTER(LEN=maxlen)FUNCTION dble2str(d,fmt) RESULT(out)1647 ELEMENTAL FUNCTION dble2str(d,fmt) RESULT(out) 1611 1648 IMPLICIT NONE 1612 1649 DOUBLE PRECISION, INTENT(IN) :: d 1613 1650 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt 1651 CHARACTER(LEN=maxlen) :: out 1614 1652 !------------------------------------------------------------------------------------------------------------------------------ 1615 1653 IF( PRESENT(fmt)) WRITE(out,fmt)d … … 1656 1694 END FUNCTION addQuotes_m 1657 1695 !============================================================================================================================== 1658 ELEMENTAL LOGICALFUNCTION needQuotes(s) RESULT(out)1696 ELEMENTAL FUNCTION needQuotes(s) RESULT(out) 1659 1697 IMPLICIT NONE 1660 1698 CHARACTER(LEN=*), INTENT(IN) :: s 1661 1699 CHARACTER(LEN=1) :: b, e 1700 LOGICAL :: out 1662 1701 !------------------------------------------------------------------------------------------------------------------------------ 1663 1702 out = .TRUE.; IF(TRIM(s) == '') RETURN … … 1671 1710 !=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. =============== 1672 1711 !============================================================================================================================== 1673 LOGICALFUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)1712 FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out) 1674 1713 IMPLICIT NONE 1675 1714 ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector). … … 1679 1718 CHARACTER(LEN=*), INTENT(IN) :: message, items, reason 1680 1719 INTEGER, OPTIONAL, INTENT(IN) :: nmax 1720 LOGICAL :: out 1681 1721 !------------------------------------------------------------------------------------------------------------------------------ 1682 1722 CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
Note: See TracChangeset
for help on using the changeset viewer.
