Changeset 3892


Ignore:
Timestamp:
May 11, 2021, 2:28:09 PM (3 years ago)
Author:
dcugnet
Message:

Missing update in the previous commit.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90

    r3852 r3892  
    1717  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
    1818  INTERFACE strTail;    MODULE PROCEDURE    strTail_1,                strTail_m; END INTERFACE strTail
    19   INTERFACE strStack;   MODULE PROCEDURE   strStack_1,               strStack_2; END INTERFACE strStack
    2019  INTERFACE strClean;   MODULE PROCEDURE   strClean_1,               strClean_m; END INTERFACE strClean
    2120  INTERFACE strReduce;  MODULE PROCEDURE  strReduce_1,              strReduce_2; END INTERFACE strReduce
    … …  
    6665  CHARACTER(LEN=*), INTENT(IN)    :: def
    6766  val = def; CALL getin(nam, val)
    68   WRITE(lunout,*)TRIM(nam)//' = '//TRIM(val)
     67  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(val)
    6968END SUBROUTINE getin_s
    7069!==============================================================================================================================
    … …  
    7574  INTEGER,          INTENT(IN)    :: def
    7675  val = def; CALL getin(nam, val)
    77   WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
     76  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
    7877END SUBROUTINE getin_i
    7978!==============================================================================================================================
    … …  
    8483  REAL,             INTENT(IN)    :: def
    8584  val = def; CALL getin(nam, val)
    86   WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
     85  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
    8786END SUBROUTINE getin_r
    8887!==============================================================================================================================
    … …  
    9392  LOGICAL,          INTENT(IN)    :: def
    9493  val = def; CALL getin(nam, val)
    95   WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
     94  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
    9695END SUBROUTINE getin_l
    9796!==============================================================================================================================
    … …  
    190189!==============================================================================================================================
    191190CHARACTER(LEN=256) FUNCTION strHead_1(str,sep) RESULT(out)
    192   CHARACTER(LEN=*), INTENT(IN) :: str, sep
    193   out = str(1:INDEX(str,sep)-1); IF(out=='') out=str
     191  CHARACTER(LEN=*),           INTENT(IN) :: str
     192  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
     193  IF(PRESENT(sep)) THEN
     194    out = str(1:INDEX(str,sep,.TRUE.)-1)
     195  ELSE
     196    out = str(1:INDEX(str,'/',.TRUE.)-1)
     197  END IF
     198  IF(out == '') out = str
    194199END FUNCTION strHead_1
    195200!==============================================================================================================================
    196201CHARACTER(LEN=256) FUNCTION strTail_1(str,sep) RESULT(out)
    197   CHARACTER(LEN=*), INTENT(IN) :: str, sep
    198   out = str(INDEX(str,sep,.TRUE.)+LEN(sep):LEN_TRIM(str)); IF(out=='') out=str
     202  CHARACTER(LEN=*),           INTENT(IN) :: str
     203  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
     204  IF(PRESENT(sep)) THEN
     205    out = str(INDEX(str,sep,.TRUE.)+LEN(sep):LEN_TRIM(str))
     206  ELSE
     207    out = str(INDEX(str,'/',.TRUE.)+1:LEN_TRIM(str))
     208  END IF
     209  IF(out == '') out = str
    199210END FUNCTION strTail_1
    200211!==============================================================================================================================
    201212FUNCTION strHead_m(str,sep) RESULT(out)
    202   CHARACTER(LEN=256), ALLOCATABLE :: out(:)
    203   CHARACTER(LEN=*),    INTENT(IN) :: str(:), sep
     213  CHARACTER(LEN=256),        ALLOCATABLE :: out(:)
     214  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
     215  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    204216  INTEGER :: k
    205   out = [(strHead_1(str(k),sep), k=1, SIZE(str))]
     217  IF(PRESENT(sep)) THEN
     218    out = [(strHead_1(str(k),sep), k=1, SIZE(str))]
     219  ELSE
     220    out = [(strHead_1(str(k)),     k=1, SIZE(str))]
     221  END IF
     222
    206223END FUNCTION strHead_m
    207224!==============================================================================================================================
    208225FUNCTION strTail_m(str,sep) RESULT(out)
    209   CHARACTER(LEN=256), ALLOCATABLE :: out(:)
    210   CHARACTER(LEN=*),    INTENT(IN) :: str(:), sep
     226  CHARACTER(LEN=256),        ALLOCATABLE :: out(:)
     227  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
     228  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    211229  INTEGER :: k
    212   out = [(strTail_1(str(k),sep), k=1, SIZE(str))]
     230  IF(PRESENT(sep)) THEN
     231    out = [(strTail_1(str(k),sep), k=1, SIZE(str))]
     232  ELSE
     233    out = [(strTail_1(str(k)),     k=1, SIZE(str))]
     234  END IF
    213235END FUNCTION strTail_m
    214236!==============================================================================================================================
    … …  
    218240!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
    219241!==============================================================================================================================
    220 FUNCTION strStack_1(str, sep) RESULT(out)
     242FUNCTION strStack(str, sep) RESULT(out)
    221243  CHARACTER(LEN=:),          ALLOCATABLE :: out
    222244  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    225247  INTEGER :: is
    226248  IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
    227   ALLOCATE(s, SOURCE=','); IF(PRESENT(sep)) s=sep
    228   out = TRIM(str(1)); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//' '//TRIM(str(is)); END DO
    229 END FUNCTION strStack_1
    230 !==============================================================================================================================
    231 FUNCTION strStack_2(str1, str2, sep) RESULT(out)
    232   CHARACTER(LEN=:),          ALLOCATABLE :: out
    233   CHARACTER(LEN=*),           INTENT(IN) :: str1(:), str2(:)
    234   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    235   CHARACTER(LEN=:), ALLOCATABLE :: s
    236   INTEGER :: is
    237   IF(SIZE(str1) == 0) THEN; out = ''; RETURN; END IF
    238   ALLOCATE(s, SOURCE=','); IF(PRESENT(sep)) s=sep
    239   out = TRIM(str1(1))//'='//TRIM(str2(1))
    240   DO is=2,SIZE(str1); out = TRIM(out)//s//' '//TRIM(str1(is))//'='//TRIM(str2(is)); END DO
    241 END FUNCTION strStack_2
     249  ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
     250  out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
     251END FUNCTION strStack
    242252!==============================================================================================================================
    243253!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
    … …  
    304314  CHARACTER(LEN=256), ALLOCATABLE :: s1(:)
    305315  INTEGER :: k, n, n1
     316  IF(PRESENT(nb)) nb = 0
    306317  CALL MOVE_ALLOC(FROM = str1, TO = s1); CALL strClean(s1)
    307318  n1 = SIZE(s1, DIM=1)                                     !--- Total nb of  elements in "s1"
    … …  
    406417
    407418  INTEGER, ALLOCATABLE :: ii(:)
    408   LOGICAL              :: ll
     419  LOGICAL              :: ll, ls
    409420  CHARACTER(LEN=256)   :: d
    410 
     421!  modname = 'strIdx'
    411422  lerr = .FALSE.
    412423  idx = strIdx1(rawList, del, ibeg, idel)
    413   IF(idx == 0)                  RETURN                               !--- No separator found                      => finished
    414   IF(.NOT.PRESENT(lSc))         RETURN; IF(.NOT.lSc ) RETURN         !--- No need to check exceptions for numbers => finished
    415   IF(INDEX('+-',del(idel))==0)  RETURN                               !--- No possible sign ambiguity              => finished
    416   ll = idx == 1                                                      !--- This is a front sign of a number
    417   IF(idx /= 1) ll = INDEX('^*/+-',rawList(idx-1:idx-1)) /= 0         !--- This is a front sign of a number after an operator
    418   IF(ll)       idx = strIdx1(rawList, del,idx+1,idel)                !---   => TO THE NEXT DELIMITER
    419   IF(idx /= 0) THEN
    420     IF(idx /= 1) ll = INDEX('eE' ,rawList(idx-1:idx-1)) /= 0         !--- Exponent sign of a number in scientific notation ?
    421     IF(ll)     idx = strIdx1(rawList, del,idx+1,idel)                !--- Identify the next delimiter
    422   END IF
    423   IF(idx /= 0) lerr = is_numeric(rawList(ibeg:idx              -1))  !--- Check whether the previous word was a number
    424   IF(idx == 0) lerr = is_numeric(rawList(ibeg:LEN_TRIM(rawList)-1))  !--- Check whether the previous word was a number
    425   IF(idx == 0) idel = 0
     424  IF(.NOT.PRESENT(lSc))                     RETURN                  !--- No need to check exceptions for numbers => finished
     425  IF(.NOT.        lSc )                     RETURN                  !--- No need to check exceptions for numbers => finished
     426  IF(idx == 0) THEN
     427    lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN                  !--- No separator detected: string must be a number
     428  END IF
     429  IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN        !--- Front separator different from +/-: error
     430  IF(is_numeric(rawList(ibeg:idx-1)))                 RETURN        !--- The input string tail is a valid number
     431  idx = strIdx1(rawList, del, idx+1, idel)                          !---   => TO THE NEXT DELIMITER
     432  IF(idx == 0) THEN
     433    lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN                  !--- No separator detected: string must be a number
     434  END IF
     435  IF(is_numeric(rawList(ibeg:idx-1)))                 RETURN        !--- The input string tail is a valid number
     436  IF(test(          INDEX('eE',rawList(idx-1:idx-1)) /= 0  &        !--- Sole possible exception: scientific notation: E+/-
     437               .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN
     438  idx = strIdx1(rawList, del, idx+1, idel)                          !---   => TO THE NEXT DELIMITER
     439  IF(idx == 0) THEN
     440    lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN                  !--- No separator detected: string must be a number
     441  END IF
     442  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
    426443
    427444CONTAINS
    … …  
    446463
    447464END FUNCTION strIdx_prv
     465!==============================================================================================================================
     466
     467
     468!==============================================================================================================================
     469!=== Return the index of first appearance of "del" in "str" starting from index "ib"
     470!==============================================================================================================================
     471INTEGER FUNCTION strIndex(str, del, ib) RESULT(idx)
     472  CHARACTER(LEN=*),  INTENT(IN)  :: str
     473  CHARACTER(LEN=*),  INTENT(IN)  :: del
     474  INTEGER,           INTENT(IN)  :: ib
     475  idx  = INDEX( str(ib:LEN_TRIM(str)), del ) + ib -1
     476END FUNCTION strIndex
    448477!==============================================================================================================================
    449478
    … …  
    484513  INTEGER,           INTENT(OUT) :: nb
    485514  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
    486 
    487515  INTEGER              :: ib, ie, jd, nr
    488516  LOGICAL              :: ll
    489517  CHARACTER(LEN=1024)  :: r
    490 
    491   modname = 'strCount'
     518!  modname = 'strCount'
    492519  lerr = .FALSE.
    493520  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    … …  
    518545  INTEGER,                         OPTIONAL, INTENT(OUT) :: n
    519546  LOGICAL :: ll
    520   modname = 'strParse'
     547!  modname = 'strParse'
    521548  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    522549  IF(.NOT.PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll)
    … …  
    527554LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, lSc, vals, n, id) RESULT(lerr)
    528555  CHARACTER(LEN=*),                          INTENT(IN)  :: rawList, delimiter(:)
    529   CHARACTER(LEN=256),           ALLOCATABLE, INTENT(OUT) :: keys(:)
     556  CHARACTER(LEN=256),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
    530557  LOGICAL,            OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
    531   CHARACTER(LEN=256), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)
    532   INTEGER,            OPTIONAL,              INTENT(OUT) :: n
    533   INTEGER,            OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)
     558  CHARACTER(LEN=256), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
     559  INTEGER,            OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
     560  INTEGER,            OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
    534561
    535562  CHARACTER(LEN=1024) :: r
    … …  
    537564  LOGICAL :: ll
    538565
    539   modname = 'strParse'
     566!  modname = 'strParse'
    540567  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    541568  IF(test(fmsg(strCount_1m(rawList, delimiter, nk, ll), "Couldn't parse list: non-numerical strings were found"),lerr)) RETURN
    … …  
    813840  LOGICAL :: ls, li, lr
    814841
    815   modname = 'dispTable'
     842!  modname = 'dispTable'
    816843  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    817844  unt = lunout; IF(PRESENT(unit)) unt = unit               !--- Specified output unit
    … …  
    892919  LOGICAL :: ls, li, lr, la
    893920
    894   modname = 'dispNamelist'
     921!  modname = 'dispNamelist'
    895922  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    896923  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
    … …  
    10771104!==============================================================================================================================
    10781105LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(out)
    1079   CHARACTER(LEN=*),   INTENT(IN)  :: str
    1080   CHARACTER(LEN=256), INTENT(OUT) :: val
     1106  CHARACTER(LEN=*),    INTENT(IN)  :: str
     1107  CHARACTER(LEN=256),  INTENT(OUT) :: val
     1108
     1109  CHARACTER(LEN=256)               :: v
    10811110  CHARACTER(LEN=1024)              :: s, vv
    1082   CHARACTER(LEN=256) :: v
    1083 !  CHARACTER(LEN=:),    ALLOCATABLE :: v
    10841111  CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
    10851112  INTEGER,             ALLOCATABLE :: ip(:)
    10861113  INTEGER :: nl, nn, i, j, im, ix
    10871114  LOGICAL :: ll
    1088   modname = 'reduceExpr_1'
     1115!  modname = 'reduceExpr_1'
    10891116  s = str
    10901117
    … …  
    11281155LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(out)
    11291156  CHARACTER(LEN=*),   INTENT(IN)  :: str
    1130   CHARACTER(LEN=256), INTENT(OUT) :: val
     1157  CHARACTER(LEN=*),  INTENT(OUT) :: val
    11311158  DOUBLE PRECISION,   ALLOCATABLE :: vl(:)
    11321159  INTEGER,            ALLOCATABLE :: id(:)
    … …  
    11391166  LOGICAL :: ll
    11401167
    1141   modname = 'reduceExpr_basic'
     1168!  modname = 'reduceExpr_basic'
    11421169  out = .TRUE.
    1143   print*,TRIM(str),is_numeric(str)
    1144 !  val =''
    1145 print*,"coincoin 1",len(str),len_trim(str)
    1146   IF(is_numeric(str)) THEN; val = TRIM(str); RETURN; END IF
    1147 print*,"coincoin 2"
     1170  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
    11481171  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
    11491172  s = str
    … …  
    11571180      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
    11581181      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
    1159       SELECT CASE(op(io))                                                      !--- Perform operation on the two values
    1160         CASE('^'); v = vm**vp
    1161         CASE('/'); v = vm/vp
    1162         CASE('*'); v = vm*vp
    1163         CASE('+'); v = vm+vp
    1164         CASE('-'); v = vm-vp
     1182      SELECT CASE(io)                                                          !--- Perform operation on the two values
     1183        CASE(1); v = vm**vp  !--- ^
     1184        CASE(2); v = vm/vp   !--- /
     1185        CASE(3); v = vm*vp   !--- *
     1186        CASE(4); v = vm+vp   !--- +
     1187        CASE(5); v = vm-vp   !--- +
    11651188      END SELECT
    11661189      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
    … …  
    11751198!==============================================================================================================================
    11761199FUNCTION reduceExpr_m(str, val) RESULT(out)
    1177   CHARACTER(LEN=*),    INTENT(IN)  :: str(:)
    1178   CHARACTER(LEN=256),  INTENT(OUT) :: val(SIZE(str))
    1179   LOGICAL                          :: out(SIZE(str))
     1200  LOGICAL,            ALLOCATABLE              :: out(:)
     1201  CHARACTER(LEN=*),                INTENT(IN)  :: str(:)
     1202  CHARACTER(LEN=256), ALLOCATABLE, INTENT(OUT) :: val(:)
    11801203  INTEGER :: i
    1181   out = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
     1204  ALLOCATE(out(SIZE(str)),val(SIZE(str)))
     1205  out(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
    11821206END FUNCTION reduceExpr_m
    11831207!==============================================================================================================================
    … …  
    11941218  WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
    11951219  READ(str,fmt,IOSTAT=e) x
    1196   out = e==0
     1220  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
     1221  IF(str == '') out = .FALSE.
    11971222END FUNCTION is_numeric
    11981223!==============================================================================================================================
    … …  
    12371262END FUNCTION bool2str
    12381263!==============================================================================================================================
    1239 ELEMENTAL CHARACTER(LEN=256) FUNCTION int2str(i) RESULT(out)
    1240   INTEGER, INTENT(IN) :: i
     1264ELEMENTAL CHARACTER(LEN=256) FUNCTION int2str(i, nDigits) RESULT(out)
     1265  INTEGER,           INTENT(IN) :: i
     1266  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
    12411267  WRITE(out,*)i
    12421268  out = ADJUSTL(out)
     1269  IF(.NOT.PRESENT(nDigits)) RETURN
     1270  IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
    12431271END FUNCTION int2str
    12441272!==============================================================================================================================
Note: See TracChangeset for help on using the changeset viewer.