Changeset 4348 for LMDZ6/trunk/libf/misc


Ignore:
Timestamp:
Nov 13, 2022, 10:23:47 PM (2 years ago)
Author:
dcugnet
Message:

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

Location:
LMDZ6/trunk/libf/misc
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4334 r4348  
    220220        IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
    221221        IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
    222         ll = strParse(str, ' ', s, n=ns)
     222        lerr = strParse(str, ' ', s, ns)
    223223        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    224224        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
    … …  
    431431      CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
    432432    ELSE                                                             !=== TRACER LINE
    433       ll = strParse(str,' ', keys = s, vals = v, n = n)              !--- Parse <key>=<val> pairs
     433      ll = strParse(str,' ', s, n, v)                                !--- Parse <key>=<val> pairs
    434434      tt = dBase(ndb)%trac(:)
    435435      tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n))    !--- Set %name and %keys
    … …  
    549549  DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
    550550  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    551     ll = strParse(tr(it)%name,   ',', ta, n=ntr)                     !--- Number of tracers
    552     ll = strParse(tr(it)%parent, ',', pa, n=npr)                     !--- Number of parents
     551    ll = strParse(tr(it)%name,   ',', ta, ntr)                       !--- Number of tracers
     552    ll = strParse(tr(it)%parent, ',', pa, npr)                       !--- Number of parents
    553553    DO ipr=1,npr                                                     !--- Loop on parents list elts
    554554      DO itr=1,ntr                                                   !--- Loop on tracers list elts
    … …  
    13081308  LOGICAL :: lo
    13091309  lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    1310   iky = strIdx(ky%key,key)
     1310  IF(.NOT.ALLOCATED(ky%key)) THEN
     1311    ALLOCATE(ky%key(1)); ky%key(1)=key
     1312    ALLOCATE(ky%val(1)); ky%val(1)=val
     1313    RETURN
     1314  END IF
     1315  iky = 0; IF(ALLOCATED(ky%key)) iky = strIdx(ky%key,key)
    13111316  IF(iky == 0) THEN
    1312     nky = SIZE(ky%key)
    1313     ALLOCATE(k(nky+1)); IF(ALLOCATED(ky%key)) k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
    1314     ALLOCATE(v(nky+1)); IF(ALLOCATED(ky%val)) v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
     1317    nky = 0; IF(ALLOCATED(ky%key)) nky = SIZE(ky%key)
     1318    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
     1319    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
    13151320  ELSE IF(lo) THEN
    13161321    ky%key(iky) = key; ky%val(iky) = val
    … …  
    18511856  newName = oldName
    18521857  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
    1853   lerr = strParse(oldName, '_', tmp, n=nt)                                     !--- Parsing: 1 up to 3 elements.
     1858  lerr = strParse(oldName, '_', tmp, nt)                                       !--- Parsing: 1 up to 3 elements.
    18541859  ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) )           !--- Phase index
    18551860  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index

  • LMDZ6/trunk/libf/misc/strings_mod.F90

    r4325 r4348  
    2121  INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
    2222  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
    23   INTERFACE strParse;   MODULE PROCEDURE   strParse_1,               strParse_m; END INTERFACE strParse
    2423  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
    2524  INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
    … …  
    444443  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
    445444  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
    446 
     445!------------------------------------------------------------------------------------------------------------------------------
    447446  INTEGER               :: idx0                                      !--- Used to display an identified non-numeric string
    448447  INTEGER, ALLOCATABLE  :: ii(:)
    449448  LOGICAL               :: ll, ls
    450449  CHARACTER(LEN=maxlen) :: d
    451 !  modname = 'strIdx'
    452450  lerr = .FALSE.
    453   idx = strIdx1(rawList, del, ibeg, idel)                            !--- del(idel) appears in "rawList" at position idx
     451  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList"
    454452  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
    455453  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
    456   IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList":
     454
     455  !=== No delimiter found: the whole string must be a valid number
     456  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
    457457    lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- String must be a number
    458     IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Update idx => rawList(ibeg:idx-1) is the whole string
    459   END IF
    460   idx0 = idx
    461   IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN         !--- Front separator different from +/-: error
    462   IF(idx/=1.AND.is_numeric(rawList(ibeg:idx-1)))      RETURN         !--- The input string tail is a valid number
    463   idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
     458    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
     459  END IF
     460
     461  IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
     462  IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
     463
     464  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
     465  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
    464466  IF(idx == 0) THEN
    465     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No delimiter detected: string must be a number
     467    lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No other delimiter: whole string must be a valid numb
    466468    IF(lerr) idx = idx0; RETURN
    467469  END IF
    468   idx0 = idx
    469   IF(is_numeric(rawList(ibeg:idx-1)))                 RETURN         !--- The input string tail is a valid number
    470   IF(test(          INDEX('eE',rawList(idx-1:idx-1)) /= 0  &         !--- Sole possible exception: scientific notation: E+/-
    471                .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN
    472   idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
    473   IF(idx == 0) THEN
    474     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No separator detected: string must be a number
    475     IF(lerr) idx = idx0; RETURN
    476   END IF
    477   lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
     470  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))                        !--- String before second delimiter is a valid number
     471
    478472CONTAINS
    479473
     474!------------------------------------------------------------------------------------------------------------------------------
    480475INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(idx)
    481   CHARACTER(LEN=*),  INTENT(IN)  :: str
    482   CHARACTER(LEN=*),  INTENT(IN)  :: del(:)
     476!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
     477!--- "id" is the index in "del(:)" of the first delimiter found.
     478  CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
    483479  INTEGER,           INTENT(IN)  :: ib
    484480  INTEGER,           INTENT(OUT) :: id
    485 
    486   INTEGER              :: nd, ns, i
    487   INTEGER, ALLOCATABLE :: ii(:)
    488 
    489   nd  = SIZE(del)                                                    !--- Number of separators
    490   ns  = LEN_TRIM(str)                                                !--- Length of the raw chain
    491   ii  = [(INDEX( str(ib:ns), del(i) ), i = 1, nd)]                   !--- Determine the next separator start index
    492   id  =  MINLOC( ii, MASK = ii /= 0, DIM = 1 )                       !--- Current delimiter index in the "delimiter(:)" list
    493   idx = 0
    494   IF(ANY(ii /= 0)) idx = MINVAL( ii, MASK = ii /= 0 ) + ib - 1       !--- Index in "str(1:ns)" of the delimiter first character
    495   IF(idx == 0) id = 0
     481!------------------------------------------------------------------------------------------------------------------------------
     482  INTEGER :: i, ix
     483  idx = 0; id = 0
     484  DO id = 1, SIZE(del)                                               !--- Test for delimiter "del(id)"
     485    ix = INDEX(str(ib:LEN_TRIM(str)), del(id))                       !--- "del(id)" appears at position "idx" in "str(ib:ns)"
     486    IF(ix /= 0 .AND. (ix < idx .OR. idx == 0 )) idx = ix
     487  END DO
     488  IF(idx /= 0) idx = idx + ib - 1                                    !--- Index counted from first character of "str"
    496489END FUNCTION strIdx1
    497490
    498491END FUNCTION strIdx_prv
    499 !==============================================================================================================================
    500 
    501 
    502 !==============================================================================================================================
    503 !=== Return the index of first appearance of "del" in "str" starting from index "ib"
    504 !==============================================================================================================================
    505 INTEGER FUNCTION strIndex(str, del, ib) RESULT(idx)
    506   CHARACTER(LEN=*),  INTENT(IN)  :: str
    507   CHARACTER(LEN=*),  INTENT(IN)  :: del
    508   INTEGER,           INTENT(IN)  :: ib
    509   idx  = INDEX( str(ib:LEN_TRIM(str)), del ) + ib -1
    510 END FUNCTION strIndex
    511492!==============================================================================================================================
    512493
    … …  
    572553!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
    573554!==============================================================================================================================
    574 LOGICAL FUNCTION strParse_1(rawList, delimiter, keys, lSc, vals, n) RESULT(lerr)
     555LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
    575556  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    576557  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
    577   LOGICAL,                            OPTIONAL, INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
     558  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    578559  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
    579   INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    580   LOGICAL :: ll
    581 !  modname = 'strParse'
    582   ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    583   IF(.NOT.PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll)
    584   IF(     PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll, vals)
    585   IF(PRESENT(n)) n = SIZE(keys)
    586 END FUNCTION strParse_1
    587 !==============================================================================================================================
    588 LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, lSc, vals, n, id) RESULT(lerr)
     560!------------------------------------------------------------------------------------------------------------------------------
     561  CHARACTER(LEN=1024) :: r
     562  INTEGER :: nr, ik, nk, ib, ie
     563  lerr = .FALSE.
     564  r  = TRIM(ADJUSTL(rawList))
     565  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
     566  CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
     567  ALLOCATE(keys(nk)); IF(PRESENT(vals)) ALLOCATE(vals(nk))
     568  CALL strParse_prv(nk, keys, vals)                                  !--- PARSE THE KEYS
     569  IF(PRESENT(n)) n = nk
     570
     571CONTAINS
     572
     573SUBROUTINE strParse_prv(nk, keys, vals)
     574!--- * Get the number of elements after parsing ("nk" only is present)
     575!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
     576  INTEGER,                         INTENT(OUT) :: nk
     577  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
     578  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
     579  nk = 1; ib = 1
     580  DO
     581    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
     582    IF(ie == ib-1) EXIT
     583    IF(PRESENT(keys)) keys(nk) = r(ib:ie-1)                          !--- Get the ikth key
     584    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse the ikth <key>=<val> pair
     585    ib = ie + LEN(delimiter)
     586    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
     587    nk = nk+1
     588  END DO
     589  IF(PRESENT(keys)) keys(nk) = r(ib:nr)                              !--- Get the last key
     590  IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))               !--- Parse the last <key>=<val> pair
     591END SUBROUTINE strParse_prv
     592
     593SUBROUTINE parseKeys(key, val)
     594  CHARACTER(LEN=*), INTENT(INOUT) :: key
     595  CHARACTER(LEN=*), INTENT(OUT)   :: val
     596  INTEGER :: ix
     597  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
     598  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
     599  key = ADJUSTL(key(1:ix-1))
     600END SUBROUTINE parseKeys
     601
     602END FUNCTION strParse
     603!==============================================================================================================================
     604LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
    589605  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    590606  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
     607  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
     608  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
    591609  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
    592   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
    593   INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
    594610  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
    595 
     611!------------------------------------------------------------------------------------------------------------------------------
    596612  CHARACTER(LEN=1024) :: r
    597613  INTEGER :: nr, ik, nk, ib, ie, jd
    598614  LOGICAL :: ll
    599 
    600 !  modname = 'strParse'
    601615  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    602616  IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
    … …  
    12521266  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
    12531267  s = str
    1254   IF(test(strParse_m(s, op, ky, .TRUE., id = id), lerr)) RETURN                !--- Parse the values
     1268  IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
    12551269  vl = str2dble(ky)                                                            !--- Conversion to doubles
    12561270  lerr = ANY(vl >= HUGE(1.d0))
    … …  
    13011315  READ(str,fmt,IOSTAT=e) x
    13021316  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
    1303   IF(str == '') out = .FALSE.
    13041317END FUNCTION is_numeric
    13051318!==============================================================================================================================
Note: See TracChangeset for help on using the changeset viewer.