Changeset 4348 for LMDZ6/trunk/libf/misc/strings_mod.F90

Timestamp:

Nov 13, 2022, 10:23:47 PM (20 months ago)

Author:

dcugnet

Message:

Fix for the backward compatibility with "traceur.def" description files (former format).

File:

• LMDZ6/trunk/libf/misc/strings_mod.F90 (modified) (5 diffs)

LMDZ6/trunk/libf/misc/strings_mod.F90

@@ -21 +21 @@
   INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
   INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
-  INTERFACE strParse;   MODULE PROCEDURE   strParse_1,               strParse_m; END INTERFACE strParse
   INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
   INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
@@ -444 +443 @@
   INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
   LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
-
+!------------------------------------------------------------------------------------------------------------------------------
   INTEGER               :: idx0                                      !--- Used to display an identified non-numeric string
   INTEGER, ALLOCATABLE  :: ii(:)
   LOGICAL               :: ll, ls
   CHARACTER(LEN=maxlen) :: d
-!  modname = 'strIdx'
   lerr = .FALSE.
-  idx = strIdx1(rawList, del, ibeg, idel)                            !--- del(idel) appears in "rawList" at position idx
+  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList" 
   IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
   IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
-  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList":
+
+  !=== No delimiter found: the whole string must be a valid number
+  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- String must be a number
-    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Update idx => rawList(ibeg:idx-1) is the whole string
-  END IF
-  idx0 = idx
-  IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN         !--- Front separator different from +/-: error
-  IF(idx/=1.AND.is_numeric(rawList(ibeg:idx-1)))      RETURN         !--- The input string tail is a valid number
-  idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
+    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
+  END IF
+
+  IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
+  IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
+
+  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
+  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
   IF(idx == 0) THEN
-    lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No delimiter detected: string must be a number
+    lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No other delimiter: whole string must be a valid numb
     IF(lerr) idx = idx0; RETURN
   END IF
-  idx0 = idx
-  IF(is_numeric(rawList(ibeg:idx-1)))                 RETURN         !--- The input string tail is a valid number
-  IF(test(          INDEX('eE',rawList(idx-1:idx-1)) /= 0  &         !--- Sole possible exception: scientific notation: E+/-
-               .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN
-  idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
-  IF(idx == 0) THEN
-    lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No separator detected: string must be a number
-    IF(lerr) idx = idx0; RETURN
-  END IF
-  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
+  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))                        !--- String before second delimiter is a valid number
+
 CONTAINS
 
+!------------------------------------------------------------------------------------------------------------------------------
 INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(idx)
-  CHARACTER(LEN=*),  INTENT(IN)  :: str
-  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)
+!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
+!--- "id" is the index in "del(:)" of the first delimiter found.
+  CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
   INTEGER,           INTENT(IN)  :: ib
   INTEGER,           INTENT(OUT) :: id
-
-  INTEGER              :: nd, ns, i
-  INTEGER, ALLOCATABLE :: ii(:)
-
-  nd  = SIZE(del)                                                    !--- Number of separators
-  ns  = LEN_TRIM(str)                                                !--- Length of the raw chain
-  ii  = [(INDEX( str(ib:ns), del(i) ), i = 1, nd)]                   !--- Determine the next separator start index
-  id  =  MINLOC( ii, MASK = ii /= 0, DIM = 1 )                       !--- Current delimiter index in the "delimiter(:)" list
-  idx = 0
-  IF(ANY(ii /= 0)) idx = MINVAL( ii, MASK = ii /= 0 ) + ib - 1       !--- Index in "str(1:ns)" of the delimiter first character
-  IF(idx == 0) id = 0
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: i, ix
+  idx = 0; id = 0
+  DO id = 1, SIZE(del)                                               !--- Test for delimiter "del(id)"
+    ix = INDEX(str(ib:LEN_TRIM(str)), del(id))                       !--- "del(id)" appears at position "idx" in "str(ib:ns)"
+    IF(ix /= 0 .AND. (ix < idx .OR. idx == 0 )) idx = ix
+  END DO
+  IF(idx /= 0) idx = idx + ib - 1                                    !--- Index counted from first character of "str"
 END FUNCTION strIdx1
 
 END FUNCTION strIdx_prv
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Return the index of first appearance of "del" in "str" starting from index "ib"
-!==============================================================================================================================
-INTEGER FUNCTION strIndex(str, del, ib) RESULT(idx)
-  CHARACTER(LEN=*),  INTENT(IN)  :: str
-  CHARACTER(LEN=*),  INTENT(IN)  :: del
-  INTEGER,           INTENT(IN)  :: ib
-  idx  = INDEX( str(ib:LEN_TRIM(str)), del ) + ib -1
-END FUNCTION strIndex
 !==============================================================================================================================
 
@@ -572 +553 @@
 !===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
 !==============================================================================================================================
-LOGICAL FUNCTION strParse_1(rawList, delimiter, keys, lSc, vals, n) RESULT(lerr)
+LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
   CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
-  LOGICAL,                            OPTIONAL, INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
+  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
   CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
-  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
-  LOGICAL :: ll
-!  modname = 'strParse'
-  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
-  IF(.NOT.PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll)
-  IF(     PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll, vals)
-  IF(PRESENT(n)) n = SIZE(keys)
-END FUNCTION strParse_1
-!==============================================================================================================================
-LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, lSc, vals, n, id) RESULT(lerr)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=1024) :: r
+  INTEGER :: nr, ik, nk, ib, ie
+  lerr = .FALSE.
+  r  = TRIM(ADJUSTL(rawList))
+  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
+  CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
+  ALLOCATE(keys(nk)); IF(PRESENT(vals)) ALLOCATE(vals(nk))
+  CALL strParse_prv(nk, keys, vals)                                  !--- PARSE THE KEYS
+  IF(PRESENT(n)) n = nk
+
+CONTAINS
+
+SUBROUTINE strParse_prv(nk, keys, vals)
+!--- * Get the number of elements after parsing ("nk" only is present)
+!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
+  INTEGER,                         INTENT(OUT) :: nk
+  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
+  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
+  nk = 1; ib = 1
+  DO
+    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
+    IF(ie == ib-1) EXIT
+    IF(PRESENT(keys)) keys(nk) = r(ib:ie-1)                          !--- Get the ikth key
+    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse the ikth <key>=<val> pair
+    ib = ie + LEN(delimiter)
+    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
+    nk = nk+1
+  END DO
+  IF(PRESENT(keys)) keys(nk) = r(ib:nr)                              !--- Get the last key
+  IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))               !--- Parse the last <key>=<val> pair
+END SUBROUTINE strParse_prv
+
+SUBROUTINE parseKeys(key, val)
+  CHARACTER(LEN=*), INTENT(INOUT) :: key
+  CHARACTER(LEN=*), INTENT(OUT)   :: val
+  INTEGER :: ix
+  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
+  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
+  key = ADJUSTL(key(1:ix-1))
+END SUBROUTINE parseKeys
+
+END FUNCTION strParse
+!==============================================================================================================================
+LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
   CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
+  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
+  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
   LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
-  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
   INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
-
+!------------------------------------------------------------------------------------------------------------------------------
   CHARACTER(LEN=1024) :: r
   INTEGER :: nr, ik, nk, ib, ie, jd
   LOGICAL :: ll
-
-!  modname = 'strParse'
   ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
   IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
@@ -1252 +1266 @@
   op = ['^','/','*','+','-']                                                   !--- List of recognized operations
   s = str
-  IF(test(strParse_m(s, op, ky, .TRUE., id = id), lerr)) RETURN                !--- Parse the values
+  IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
   vl = str2dble(ky)                                                            !--- Conversion to doubles
   lerr = ANY(vl >= HUGE(1.d0))
@@ -1301 +1315 @@
   READ(str,fmt,IOSTAT=e) x
   out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
-  IF(str == '') out = .FALSE.
 END FUNCTION is_numeric
 !==============================================================================================================================