Ignore:
Timestamp:
Nov 15, 2022, 4:14:52 PM (20 months ago)
Author:
dcugnet
Message:

Fix in strinngs_mod + few more comments in this module.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r4348 r4349  
    3737CONTAINS
    3838
     39!==============================================================================================================================
    3940LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
    4041  LOGICAL, INTENT(IN)  :: lcond
    … …  
    4243  lerr = lcond; lout = lcond
    4344END FUNCTION test
     45!==============================================================================================================================
     46
    4447
    4548!==============================================================================================================================
    … …  
    104107  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    105108  INTEGER,          OPTIONAL, INTENT(IN) :: unit
     109!------------------------------------------------------------------------------------------------------------------------------
    106110  CHARACTER(LEN=maxlen) :: subn
    107111  INTEGER :: unt
    … …  
    120124  INTEGER,          OPTIONAL, INTENT(IN) :: unit
    121125  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
     126!------------------------------------------------------------------------------------------------------------------------------
    122127  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
    123128  CHARACTER(LEN=maxlen) :: subn
    … …  
    137142  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    138143  INTEGER,          OPTIONAL, INTENT(IN) :: unit
     144!------------------------------------------------------------------------------------------------------------------------------
    139145  CHARACTER(LEN=maxlen) :: subn
    140146  INTEGER :: unt
    … …  
    151157  INTEGER,          OPTIONAL, INTENT(IN) :: unit
    152158  INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
     159!------------------------------------------------------------------------------------------------------------------------------
    153160  CHARACTER(LEN=maxlen) :: subn
    154161  INTEGER :: unt, nmx
    … …  
    195202  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    196203  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
     204!------------------------------------------------------------------------------------------------------------------------------
    197205  LOGICAL :: lf
    198206  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    … …  
    210218  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    211219  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
     220!------------------------------------------------------------------------------------------------------------------------------
    212221  LOGICAL :: lf
    213222  INTEGER :: k
    … …  
    229238  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    230239  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
     240!------------------------------------------------------------------------------------------------------------------------------
    231241  LOGICAL :: lf
    232242  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    … …  
    244254  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    245255  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
     256!------------------------------------------------------------------------------------------------------------------------------
    246257  LOGICAL :: lf
    247258  INTEGER :: k
    … …  
    264275  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    265276  LOGICAL,          OPTIONAL, INTENT(IN) :: mask(:)
     277!------------------------------------------------------------------------------------------------------------------------------
    266278  CHARACTER(LEN=:), ALLOCATABLE :: s
    267279  INTEGER :: is, i0
    … …  
    284296  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    285297  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
     298!------------------------------------------------------------------------------------------------------------------------------
    286299  CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
    287300  CHARACTER(LEN=maxlen) :: sp
    … …  
    338351  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
    339352  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
     353!------------------------------------------------------------------------------------------------------------------------------
    340354  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
    341355  INTEGER :: k, n, n1
    … …  
    354368  CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
    355369  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
     370!------------------------------------------------------------------------------------------------------------------------------
    356371  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
    357372  INTEGER :: k
    … …  
    373388
    374389!==============================================================================================================================
    375 !=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s" =================================
     390!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
     391!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
    376392!==============================================================================================================================
    377393INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
    … …  
    385401  INTEGER, OPTIONAL, INTENT(OUT) :: n
    386402  INTEGER,           ALLOCATABLE :: out(:)
     403!------------------------------------------------------------------------------------------------------------------------------
    387404  INTEGER :: k
    388405  out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
    … …  
    399416  INTEGER, OPTIONAL, INTENT(OUT) :: n
    400417  INTEGER,           ALLOCATABLE :: out(:)
     418!------------------------------------------------------------------------------------------------------------------------------
    401419  INTEGER :: k
    402420  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
    … …  
    408426  INTEGER, OPTIONAL, INTENT(OUT) :: n
    409427  INTEGER,           ALLOCATABLE :: out(:)
     428!------------------------------------------------------------------------------------------------------------------------------
    410429  INTEGER :: k
    411430  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
    … …  
    417436  INTEGER, OPTIONAL, INTENT(OUT) :: n
    418437  INTEGER,           ALLOCATABLE :: out(:)
     438!------------------------------------------------------------------------------------------------------------------------------
    419439  INTEGER :: k
    420440  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
    421441  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    422442END FUNCTION find_boo
    423 !==============================================================================================================================
    424 
    425 
    426 
    427 !==============================================================================================================================
    428 !=== GET 1ST APPEARANCE INDEX OF EACH ELEMENT OF "t(:)" IN "s(:)" (UNFOUND: INDEX=0) ==========================================
    429 !=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n"                                 ==========================================
    430443!==============================================================================================================================
    431444
    … …  
    455468  !=== No delimiter found: the whole string must be a valid number
    456469  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
    457     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- String must be a number
     470    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- String must be a number
    458471    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
    459472  END IF
    … …  
    465478  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
    466479  IF(idx == 0) THEN
    467     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No other delimiter: whole string must be a valid numb
     480    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- No other delimiter: whole string must be a valid numb
    468481    IF(lerr) idx = idx0; RETURN
    469482  END IF
    470   lerr = .NOT.is_numeric(rawList(ibeg:idx-1))                        !--- String before second delimiter is a valid number
     483  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
    471484
    472485CONTAINS
    473486
    474487!------------------------------------------------------------------------------------------------------------------------------
    475 INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(idx)
     488INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
    476489!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
    477490!--- "id" is the index in "del(:)" of the first delimiter found.
     491  IMPLICIT NONE
    478492  CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
    479493  INTEGER,           INTENT(IN)  :: ib
    480494  INTEGER,           INTENT(OUT) :: id
    481495!------------------------------------------------------------------------------------------------------------------------------
    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"
     496  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
     497  IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
    489498END FUNCTION strIdx1
    490499
    … …  
    501510  INTEGER,           INTENT(OUT) :: nb
    502511  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
     512!------------------------------------------------------------------------------------------------------------------------------
    503513  LOGICAL :: ll
    504514  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    … …  
    511521  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
    512522  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
    513 
     523!------------------------------------------------------------------------------------------------------------------------------
    514524  LOGICAL :: ll
    515525  INTEGER :: id
    516 
    517526  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
    518527  out = .TRUE.
    … …  
    528537  INTEGER,           INTENT(OUT) :: nb
    529538  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
     539!------------------------------------------------------------------------------------------------------------------------------
    530540  INTEGER              :: ib, ie, jd, nr
    531541  LOGICAL              :: ll
    532542  CHARACTER(LEN=1024)  :: r
    533 !  modname = 'strCount'
    534543  lerr = .FALSE.
    535544  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    … …  
    540549    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
    541550    IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
    542     IF(jd == 0) EXIT
     551    IF(ie == 0 .OR. jd == 0) EXIT
    543552    ib = ie + LEN(delimiter(jd))
    544553    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
    … …  
    560569!------------------------------------------------------------------------------------------------------------------------------
    561570  CHARACTER(LEN=1024) :: r
    562   INTEGER :: nr, ik, nk, ib, ie
     571  INTEGER :: nr, nk
    563572  lerr = .FALSE.
    564573  r  = TRIM(ADJUSTL(rawList))
    565574  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
    566575  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
     576  ALLOCATE(keys(nk))
     577  IF(PRESENT(vals)) THEN
     578    ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals)            !--- PARSE THE KEYS
     579  ELSE
     580    CALL strParse_prv(nk, keys)                                      !--- PARSE THE KEYS
     581  END IF
    569582  IF(PRESENT(n)) n = nk
    570583
    571584CONTAINS
    572585
    573 SUBROUTINE strParse_prv(nk, keys, vals)
    574 !--- * Get the number of elements after parsing ("nk" only is present)
     586!------------------------------------------------------------------------------------------------------------------------------
     587SUBROUTINE strParse_prv(nkeys, keys, vals)
     588!--- * Get the number of elements after parsing ("nkeys" only is present)
    575589!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
    576   INTEGER,                         INTENT(OUT) :: nk
     590  IMPLICIT NONE
     591  INTEGER,                         INTENT(OUT) :: nkeys
    577592  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
    578593  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
    579   nk = 1; ib = 1
     594!------------------------------------------------------------------------------------------------------------------------------
     595  INTEGER :: ib, ie
     596  nkeys = 1; ib = 1
    580597  DO
    581598    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
    582599    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
     600    IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1)                       !--- Get the ikth key
     601    IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))       !--- Parse the ikth <key>=<val> pair
    585602    ib = ie + LEN(delimiter)
    586603    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
     604    nkeys = nkeys+1
     605  END DO
     606  IF(PRESENT(keys)) keys(nkeys) = r(ib:nr)                           !--- Get the last key
     607  IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))         !--- Parse the last <key>=<val> pair
    591608END SUBROUTINE strParse_prv
    592609
     610!------------------------------------------------------------------------------------------------------------------------------
    593611SUBROUTINE parseKeys(key, val)
    594612  CHARACTER(LEN=*), INTENT(INOUT) :: key
    595613  CHARACTER(LEN=*), INTENT(OUT)   :: val
     614!------------------------------------------------------------------------------------------------------------------------------
    596615  INTEGER :: ix
    597616  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
    … …  
    639658CONTAINS
    640659
     660!------------------------------------------------------------------------------------------------------------------------------
    641661SUBROUTINE parseKeys(key, val)
    642662  CHARACTER(LEN=*), INTENT(INOUT) :: key
    643663  CHARACTER(LEN=*), INTENT(OUT)   :: val
     664!------------------------------------------------------------------------------------------------------------------------------
    644665  INTEGER :: ix
    645666  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
    … …  
    659680  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    660681  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
    661 
     682!------------------------------------------------------------------------------------------------------------------------------
    662683  CHARACTER(LEN=1024) :: s, t
    663684  INTEGER :: i0, ix, nk, ns
    664685  LOGICAL :: lsur, lb, le
    665 
    666686  lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
    667687  nk = LEN_TRIM(key)
    … …  
    702722  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    703723  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
     724!------------------------------------------------------------------------------------------------------------------------------
    704725  CHARACTER(LEN=maxlen), POINTER     :: s
    705726  LOGICAL :: lv(10)
    … …  
    721742  CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    722743  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
     744!------------------------------------------------------------------------------------------------------------------------------
    723745  CHARACTER(LEN=maxlen), POINTER     :: s(:)
    724746  LOGICAL :: lv(10)
    … …  
    743765  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    744766  INTEGER, ALLOCATABLE :: out(:)
     767!------------------------------------------------------------------------------------------------------------------------------
    745768  INTEGER, POINTER     :: i
    746769  LOGICAL :: lv(10)
    … …  
    762785  INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    763786  INTEGER, ALLOCATABLE :: out(:,:)
     787!------------------------------------------------------------------------------------------------------------------------------
    764788  INTEGER, POINTER     :: i(:)
    765789  LOGICAL :: lv(10)
    … …  
    784808  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    785809  REAL, ALLOCATABLE :: out(:)
     810!------------------------------------------------------------------------------------------------------------------------------
    786811  REAL, POINTER     :: r
    787812  LOGICAL :: lv(10)
    … …  
    803828  REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    804829  REAL, ALLOCATABLE :: out(:,:)
     830!------------------------------------------------------------------------------------------------------------------------------
    805831  REAL, POINTER     :: r(:)
    806832  LOGICAL :: lv(10)
    … …  
    825851  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    826852  DOUBLE PRECISION, ALLOCATABLE :: out(:)
     853!------------------------------------------------------------------------------------------------------------------------------
    827854  DOUBLE PRECISION, POINTER     :: d
    828855  LOGICAL :: lv(10)
    … …  
    844871  DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    845872  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
     873!------------------------------------------------------------------------------------------------------------------------------
    846874  DOUBLE PRECISION, POINTER     :: d(:)
    847875  LOGICAL :: lv(10)
    … …  
    883911  INTEGER,          OPTIONAL, INTENT(IN)  :: unit          !--- Output unit (default: screen)
    884912  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub           !--- Subroutine name
    885 
     913!------------------------------------------------------------------------------------------------------------------------------
    886914  CHARACTER(LEN=2048) :: row
    887915  CHARACTER(LEN=maxlen)  :: rFm, el, subn
    … …  
    893921  INTEGER, PARAMETER   :: nm=1                             !--- Space between values & columns
    894922  LOGICAL :: ls, li, lr
    895 
    896923  subn = '';    IF(PRESENT(sub)) subn = sub
    897924  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    … …  
    968995      nr = LEN_TRIM(row)-1                                           !--- Final separator removed
    969996      CALL msg(row(1:nr), subn, unit=unt)
    970       IF(ir /= 1) CYCLE                                              !--- Titles are underlined
     997      IF(ir /= 1) CYCLE                                              !--- Titles only are underlined
    971998      row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
    972999      DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
    … …  
    9891016  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
    9901017  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
    991 
     1018!------------------------------------------------------------------------------------------------------------------------------
    9921019  CHARACTER(LEN=maxlen)  :: rFm, el
    9931020  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
    … …  
    9971024  INTEGER, ALLOCATABLE :: n(:)
    9981025  LOGICAL :: ls, li, lr, la
    999 
    1000 !  modname = 'dispNamelist'
    10011026  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    10021027  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
    … …  
    10701095  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
    10711096  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
    1072 
    10731097  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
    10741098  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
    … …  
    10761100  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    10771101  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
     1102!------------------------------------------------------------------------------------------------------------------------------
    10781103  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
    10791104  LOGICAL,                    ALLOCATABLE :: m(:)
    … …  
    11531178  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    11541179  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
    1155 
     1180!------------------------------------------------------------------------------------------------------------------------------
    11561181  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
    11571182  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:), vnm(:)
    … …  
    12031228  CHARACTER(LEN=*),      INTENT(IN)  :: str
    12041229  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
    1205 
     1230!------------------------------------------------------------------------------------------------------------------------------
    12061231  CHARACTER(LEN=maxlen)              :: v
    12071232  CHARACTER(LEN=1024)                :: s, vv
    … …  
    12101235  INTEGER :: nl, nn, i, j, im, ix
    12111236  LOGICAL :: ll
    1212 !  modname = 'reduceExpr_1'
    12131237  s = str
    12141238
    … …  
    12571281  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
    12581282  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
    1259 
     1283!------------------------------------------------------------------------------------------------------------------------------
    12601284  CHARACTER(LEN=1024) :: s
    12611285  DOUBLE PRECISION :: v, vm, vp
    12621286  INTEGER      :: i, ni, io
    1263 
    12641287  lerr = .FALSE.
    12651288  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
    … …  
    12751298      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
    12761299      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
    1277       SELECT CASE(io)                                                          !--- Perform operation on the two values
    1278         CASE(1); v = vm**vp  !--- ^
    1279         CASE(2); v = vm/vp   !--- /
    1280         CASE(3); v = vm*vp   !--- *
    1281         CASE(4); v = vm+vp   !--- +
    1282         CASE(5); v = vm-vp   !--- +
     1300      SELECT CASE(op(io))                                                          !--- Perform operation on the two values
     1301        CASE('^'); v = vm**vp
     1302        CASE('/'); v = vm/vp
     1303        CASE('*'); v = vm*vp
     1304        CASE('+'); v = vm+vp
     1305        CASE('-'); v = vm-vp
    12831306      END SELECT
    12841307      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
    … …  
    12961319  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
    12971320  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1321!------------------------------------------------------------------------------------------------------------------------------
    12981322  INTEGER :: i
    12991323  ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
    … …  
    13601384  INTEGER,           INTENT(IN) :: i
    13611385  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
     1386!------------------------------------------------------------------------------------------------------------------------------
    13621387  WRITE(out,*)i
    13631388  out = ADJUSTL(out)
    … …  
    13691394  REAL,                       INTENT(IN) :: r
    13701395  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1396!------------------------------------------------------------------------------------------------------------------------------
    13711397  IF(     PRESENT(fmt)) WRITE(out,fmt)r
    13721398  IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
    … …  
    13771403  DOUBLE PRECISION,           INTENT(IN) :: d
    13781404  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1405!------------------------------------------------------------------------------------------------------------------------------
    13791406  IF(     PRESENT(fmt)) WRITE(out,fmt)d
    13801407  IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
    … …  
    13971424!==============================================================================================================================
    13981425
     1426
    13991427!==============================================================================================================================
    14001428FUNCTION addQuotes_1(s) RESULT(out)
    … …  
    14071435  CHARACTER(LEN=*), INTENT(IN)  :: s(:)
    14081436  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
     1437!------------------------------------------------------------------------------------------------------------------------------
    14091438  INTEGER :: k, n
    14101439  n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
    … …  
    14181447  CHARACTER(LEN=*), INTENT(IN) :: s
    14191448  CHARACTER(LEN=1) :: b, e
     1449!------------------------------------------------------------------------------------------------------------------------------
    14201450  out = .TRUE.; IF(TRIM(s) == '') RETURN
    14211451  b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
    … …  
    14301460LOGICAL FUNCTION testFile_1(fname) RESULT(out)
    14311461  CHARACTER(LEN=*), INTENT(IN) :: fname
     1462!------------------------------------------------------------------------------------------------------------------------------
    14321463  INTEGER :: ierr
    14331464  OPEN(90, FILE=fname, FORM='formatted', STATUS='old', IOSTAT=ierr); CLOSE(99)
    … …  
    14391470  CHARACTER(LEN=*), INTENT(IN) :: fname(:)
    14401471  INTEGER :: k
     1472!------------------------------------------------------------------------------------------------------------------------------
    14411473  out = [(testFile_1(fname(k)), k=1, SIZE(fname))]
    14421474END FUNCTION testFile_m
    … …  
    14541486  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
    14551487  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
     1488!------------------------------------------------------------------------------------------------------------------------------
    14561489  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
    14571490  INTEGER :: i, nmx
    … …  
    14761509
    14771510
    1478 
    14791511END MODULE strings_mod
Note: See TracChangeset for help on using the changeset viewer.