Ignore:
Timestamp:
Jul 1, 2024, 11:25:05 AM (3 months ago)
Author:
dcugnet
Message:
  • strings_mod:
    • remove "test()" function (was not very clear)
    • modifications of the "str2bool" function: result is O/1 for .FALSE./.TRUE. and -1 if the string was not a boolean.
    • more general "find()" function (for several numerical types)
    • more general "cat()" function (can append a 2D array with vectors, 1D arrays with scalars)
    • few simplifications (in "strParse") and minor changes
  • readTracFiles_mod:
    • remove internal usage of direct keys ("%" symbol) in favor of the "getKey" function. => moving toward a totally generic tracers derived type.
    • improve the internal management of the error return value "lerr".
    • remove "fGetKey", "fGetKeys", "setDirectKeys" functions
    • new functions to add/remove a phase: "addPhase", "delPhase"
    • more general "addKey(key[(:)], val[(:)], ky(:), [lOverWrite])" function: . input argument "val" can be string/integer/real/logical . (key, val, ky ): add the <key> =<val> pair to ky . (key, val(:), ky(:)): add the <key> =<val(i)> pair to ky(i) for 1<=i<=SIZE(ky) . (key(:), val(:), ky(:)): add the <key(i)>=<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
    • more general "getKey(key[(:)], val[(:)], itr [, ky(:)][, nam(:)][, def][, lDisp])" (tracer index version)

and "getKey(key[(:)], val[(:)], tname[, ky(:)]. [, def][, lDisp])" (tracer name version) functions:

. output argument "val" can be string/integer/real/logical
. if present, the default value <def> is retained if the corresponding key was not found.
. get values from "ky(:)" if present, otherwise from internal database "tracers(:)" or "isotope ».
. if "keyn" is a vector, try with each element in indices order until a value is found
. (key[(:)], val, itr/tname[,ky(:)][, ...]): get the value <val> of tracer nr. itr or named "tname"
. (key[(:)], val(:), itr/tname[,ky(:)][, ...]): same + parsing of the value with « , », then storage in <val(:)>
. (key[(:)], val(:)[, ky(:)][, nam(:)][, ...]): same for all tracers (optional names list <nam(:)>) of database.
. (key[(:)], val(:), tname(:)[, ky(:)][, ...]): same for the tracers named « tnames(:)"

  • more general "dispTraSection" function
  • much simplified "indexUpdate" function ; "ancestor*" and "idxAncestor" functions are removed.
  • "readIsotopesFile" is renamed to "processIsotopes" for more clarity
  • cosmetic changes
  • fix for isotopes: iq_val and iq_liq are usable for "q" only, not for "q_follow" and "zx_defau_diag" => use hardcoded indices (1 for vapor and 2 for liquid) for these variables
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r4987 r5001  
    1010  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
    1111  PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
    12   PUBLIC :: addQuotes, checkList, removeComment, test
     12  PUBLIC :: addQuotes, checkList, removeComment
    1313
    1414  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
    … …  
    2222  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
    2323  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
    24   INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
    25 !                 horzcat_d1,  horzcat_dm,
    26                                            horzcat_sm,  horzcat_im,  horzcat_rm; END INTERFACE cat
    27   INTERFACE find;         MODULE PROCEDURE    strFind,    find_int,    find_boo; END INTERFACE find
     24  INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
     25                                          horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
     26                                          horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
     27                                          horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
     28  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
     29  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
    2830  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
    2931  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
    … …  
    3638CONTAINS
    3739
    38 !==============================================================================================================================
    39 LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
    40   LOGICAL, INTENT(IN)  :: lcond
    41   LOGICAL, INTENT(OUT) :: lout
    42   lerr = lcond; lout = lcond
    43 END FUNCTION test
    44 !==============================================================================================================================
    45 
    4640
    4741!==============================================================================================================================
    4842SUBROUTINE init_printout(lunout_, prt_level_)
     43  IMPLICIT NONE
    4944  INTEGER, INTENT(IN) :: lunout_, prt_level_
    5045  lunout    = lunout_
    … …  
    5853!==============================================================================================================================
    5954SUBROUTINE getin_s(nam, val, def)
    60 USE ioipsl_getincom, ONLY: getin
     55  USE ioipsl_getincom, ONLY: getin
     56  IMPLICIT NONE
    6157  CHARACTER(LEN=*), INTENT(IN)    :: nam
    6258  CHARACTER(LEN=*), INTENT(INOUT) :: val
    … …  
    6763!==============================================================================================================================
    6864SUBROUTINE getin_i(nam, val, def)
    69 USE ioipsl_getincom, ONLY: getin
     65  USE ioipsl_getincom, ONLY: getin
     66  IMPLICIT NONE
    7067  CHARACTER(LEN=*), INTENT(IN)    :: nam
    7168  INTEGER,          INTENT(INOUT) :: val
    … …  
    7673!==============================================================================================================================
    7774SUBROUTINE getin_r(nam, val, def)
    78 USE ioipsl_getincom, ONLY: getin
     75  USE ioipsl_getincom, ONLY: getin
     76  IMPLICIT NONE
    7977  CHARACTER(LEN=*), INTENT(IN)    :: nam
    8078  REAL,             INTENT(INOUT) :: val
    … …  
    8583!==============================================================================================================================
    8684SUBROUTINE getin_l(nam, val, def)
    87 USE ioipsl_getincom, ONLY: getin
     85  USE ioipsl_getincom, ONLY: getin
     86  IMPLICIT NONE
    8887  CHARACTER(LEN=*), INTENT(IN)    :: nam
    8988  LOGICAL,          INTENT(INOUT) :: val
    … …  
    9998!==============================================================================================================================
    10099SUBROUTINE msg_1(str, modname, ll, unit)
     100  IMPLICIT NONE
    101101  !--- Display a simple message "str". Optional parameters:
    102102  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
    … …  
    118118!==============================================================================================================================
    119119SUBROUTINE msg_m(str, modname, ll, unit, nmax)
     120  IMPLICIT NONE
    120121  !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
    121122  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    138139!==============================================================================================================================
    139140LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
     141  IMPLICIT NONE
    140142  CHARACTER(LEN=*),           INTENT(IN) :: str
    141143  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    … …  
    152154!==============================================================================================================================
    153155LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
     156  IMPLICIT NONE
    154157  CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
    155158  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    … …  
    173176!==============================================================================================================================
    174177ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
     178  IMPLICIT NONE
    175179  CHARACTER(LEN=*), INTENT(IN) :: str
    176180  INTEGER :: k
    … …  
    182186!==============================================================================================================================
    183187ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
     188  IMPLICIT NONE
    184189  CHARACTER(LEN=*), INTENT(IN) :: str
    185190  INTEGER :: k
    … …  
    199204!==============================================================================================================================
    200205CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
     206  IMPLICIT NONE
    201207  CHARACTER(LEN=*),           INTENT(IN) :: str
    202208  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    214220!==============================================================================================================================
    215221FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
     222  IMPLICIT NONE
    216223  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    217224  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    235242!==============================================================================================================================
    236243CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
     244  IMPLICIT NONE
    237245  CHARACTER(LEN=*),           INTENT(IN) :: str
    238246  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    250258!==============================================================================================================================
    251259FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
     260  IMPLICIT NONE
    252261  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    253262  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    271280!==============================================================================================================================
    272281FUNCTION strStack(str, sep, mask) RESULT(out)
     282  IMPLICIT NONE
    273283  CHARACTER(LEN=:),          ALLOCATABLE :: out
    274284  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    292302!==============================================================================================================================
    293303FUNCTION strStackm(str, sep, nmax) RESULT(out)
     304  IMPLICIT NONE
    294305  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    295306  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    324335!==============================================================================================================================
    325336SUBROUTINE strClean_1(str)
     337  IMPLICIT NONE
    326338  CHARACTER(LEN=*), INTENT(INOUT) :: str
    327339  INTEGER :: k, n, m
    … …  
    337349!==============================================================================================================================
    338350SUBROUTINE strClean_m(str)
     351  IMPLICIT NONE
    339352  CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
    340353  INTEGER :: k
    … …  
    349362!==============================================================================================================================
    350363SUBROUTINE strReduce_1(str, nb)
     364  IMPLICIT NONE
    351365  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
    352366  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
    … …  
    366380!==============================================================================================================================
    367381SUBROUTINE strReduce_2(str1, str2)
     382  IMPLICIT NONE
    368383  CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
    369384  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
    … …  
    392407!==============================================================================================================================
    393408INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
     409  IMPLICIT NONE
    394410  CHARACTER(LEN=*), INTENT(IN) :: str(:), s
    395411  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
    … …  
    398414!==============================================================================================================================
    399415FUNCTION strIdx_m(str, s, n) RESULT(out)
     416  IMPLICIT NONE
    400417  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
    401418  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    412429!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
    413430!==============================================================================================================================
    414 FUNCTION strFind(str, s, n) RESULT(out)
     431FUNCTION strFind_1(str, s, n) RESULT(out)
     432  IMPLICIT NONE
    415433  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
    416434  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    420438  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
    421439  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    422 END FUNCTION strFind
    423 !==============================================================================================================================
    424 FUNCTION find_int(i,j,n) RESULT(out)
     440END FUNCTION strFind_1
     441!==============================================================================================================================
     442FUNCTION strFind_m(str, s, n) RESULT(out)
     443  IMPLICIT NONE
     444  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
     445  INTEGER, OPTIONAL, INTENT(OUT) :: n
     446  INTEGER,           ALLOCATABLE :: out(:)
     447!------------------------------------------------------------------------------------------------------------------------------
     448  INTEGER :: k
     449  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
     450  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
     451END FUNCTION strFind_m
     452!==============================================================================================================================
     453FUNCTION intFind_1(i,j,n) RESULT(out)
     454  IMPLICIT NONE
    425455  INTEGER,           INTENT(IN)  :: i(:), j
    426456  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    430460  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
    431461  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    432 END FUNCTION find_int
    433 !==============================================================================================================================
    434 FUNCTION find_boo(l,n) RESULT(out)
    435   LOGICAL,           INTENT(IN)  :: l(:)
     462END FUNCTION intFind_1
     463!==============================================================================================================================
     464FUNCTION intFind_m(i,j,n) RESULT(out)
     465  IMPLICIT NONE
     466  INTEGER,           INTENT(IN)  :: i(:), j(:)
     467  INTEGER, OPTIONAL, INTENT(OUT) :: n
     468  INTEGER,           ALLOCATABLE :: out(:)
     469!------------------------------------------------------------------------------------------------------------------------------
     470  INTEGER :: k
     471  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
     472  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
     473END FUNCTION intFind_m
     474!==============================================================================================================================
     475FUNCTION booFind(l,n) RESULT(out)
     476   IMPLICIT NONE
     477 LOGICAL,           INTENT(IN)  :: l(:)
    436478  INTEGER, OPTIONAL, INTENT(OUT) :: n
    437479  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    440482  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
    441483  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    442 END FUNCTION find_boo
     484END FUNCTION booFind
    443485!==============================================================================================================================
    444486
    … …  
    450492!==============================================================================================================================
    451493LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
     494  IMPLICIT NONE
    452495  CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
    453496  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
    … …  
    469512  END IF
    470513
    471   IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
    472   IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
     514  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
     515  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number
    473516
    474517  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
    … …  
    503546!==============================================================================================================================
    504547LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
     548  IMPLICIT NONE
    505549  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    506550  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
    … …  
    514558!==============================================================================================================================
    515559LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
     560  IMPLICIT NONE
    516561  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    517562  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
    … …  
    530575!==============================================================================================================================
    531576LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
     577  IMPLICIT NONE
    532578  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    533579  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
    … …  
    560606!==============================================================================================================================
    561607LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
     608  IMPLICIT NONE
    562609  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    563610  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
    … …  
    570617  r  = TRIM(ADJUSTL(rawList))
    571618  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
    572   CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
    573   ALLOCATE(keys(nk))
    574   IF(PRESENT(vals)) THEN
    575     ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals)            !--- PARSE THE KEYS
    576   ELSE
    577     CALL strParse_prv(nk, keys)                                      !--- PARSE THE KEYS
    578   END IF
    579   IF(PRESENT(n)) n = nk
     619  nk = countK()                                                      !--- COUNT THE ELEMENTS
     620  CALL parseK(keys)                                                  !--- PARSE THE KEYS
     621  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
     622  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS
     623  IF(PRESENT(vals)) &
     624print*,'key ; val = '//TRIM(strStack(keys))//' ; '//TRIM(strStack(vals))
    580625
    581626CONTAINS
    582627
    583628!------------------------------------------------------------------------------------------------------------------------------
    584 SUBROUTINE strParse_prv(nkeys, keys, vals)
    585 !--- * Get the number of elements after parsing ("nkeys" only is present)
    586 !--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
    587   IMPLICIT NONE
    588   INTEGER,                         INTENT(OUT) :: nkeys
    589   CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
    590   CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
    591 !------------------------------------------------------------------------------------------------------------------------------
    592   INTEGER :: ib, ie
    593   nkeys = 1; ib = 1
     629INTEGER FUNCTION countK() RESULT(nkeys)
     630!--- Get the number of elements after parsing.
     631  IMPLICIT NONE
     632!------------------------------------------------------------------------------------------------------------------------------
     633  INTEGER :: ib, ie, nl
     634  nkeys = 1; ib = 1; nl = LEN(delimiter)
    594635  DO
    595636    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
    596637    IF(ie == ib-1) EXIT
    597     IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1)                       !--- Get the ikth key
    598     IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))       !--- Parse the ikth <key>=<val> pair
     638    ib = ie + nl
     639    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
     640      ib = ib + 1
     641    END DO     !--- Skip spaces before next chain
     642    nkeys = nkeys+1
     643  END DO
     644END FUNCTION countK
     645
     646!------------------------------------------------------------------------------------------------------------------------------
     647SUBROUTINE parseK(keys)
     648!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
     649  IMPLICIT NONE
     650  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
     651!------------------------------------------------------------------------------------------------------------------------------
     652  INTEGER :: ib, ie, ik
     653  ALLOCATE(keys(nk))
     654  ib = 1
     655  DO ik = 1, nk
     656    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
     657    IF(ie == ib-1) EXIT
     658    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
    599659    ib = ie + LEN(delimiter)
    600660    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
    601     nkeys = nkeys+1
    602   END DO
    603   IF(PRESENT(keys)) keys(nkeys) = r(ib:nr)                           !--- Get the last key
    604   IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))         !--- Parse the last <key>=<val> pair
    605 END SUBROUTINE strParse_prv
    606 
    607 !------------------------------------------------------------------------------------------------------------------------------
    608 SUBROUTINE parseKeys(key, val)
    609   CHARACTER(LEN=*), INTENT(INOUT) :: key
    610   CHARACTER(LEN=*), INTENT(OUT)   :: val
    611 !------------------------------------------------------------------------------------------------------------------------------
    612   INTEGER :: ix
    613   ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
    614   val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
    615   key = ADJUSTL(key(1:ix-1))
    616 END SUBROUTINE parseKeys
     661  END DO
     662  keys(ik) = r(ib:nr)                                                !--- Get the last key
     663END SUBROUTINE parseK
     664
     665!------------------------------------------------------------------------------------------------------------------------------
     666SUBROUTINE parseV(vals)
     667!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
     668  IMPLICIT NONE
     669  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
     670!------------------------------------------------------------------------------------------------------------------------------
     671  CHARACTER(LEN=maxlen) :: key
     672  INTEGER :: ik, ix
     673  ALLOCATE(vals(nk))
     674  DO ik = 1, nk; key = keys(ik)
     675    vals(ik) = ''
     676    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
     677    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
     678    keys(ik) = ADJUSTL(key(1:ix-1))
     679  END DO
     680END SUBROUTINE parseV
    617681
    618682END FUNCTION strParse
    619683!==============================================================================================================================
    620684LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
     685  IMPLICIT NONE
    621686  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    622687  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
    … …  
    630695  LOGICAL :: ll
    631696  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    632   IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
     697  lerr = strCount_1m(rawList, delimiter, nk, ll)
     698  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
    633699
    634700  !--- FEW ALLOCATIONS
    … …  
    643709  ib = 1
    644710  DO ik = 1, nk-1
    645     IF(test(fmsg('Non-numeric values found', ll=strIdx_prv(r, delimiter, ib, ie, jd, ll)),lerr)) RETURN
     711    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
     712    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
    646713    keys(ik) = r(ib:ie-1)
    647714    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
    … …  
    657724!------------------------------------------------------------------------------------------------------------------------------
    658725SUBROUTINE parseKeys(key, val)
     726  IMPLICIT NONE
    659727  CHARACTER(LEN=*), INTENT(INOUT) :: key
    660728  CHARACTER(LEN=*), INTENT(OUT)   :: val
    … …  
    674742!==============================================================================================================================
    675743SUBROUTINE strReplace_1(str, key, val, lsurr)
     744  IMPLICIT NONE
    676745  CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
    677746  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    … …  
    700769!==============================================================================================================================
    701770SUBROUTINE strReplace_m(str, key, val, lsurr)
     771  IMPLICIT NONE
    702772  CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
    703773  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    … …  
    714784!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
    715785!==============================================================================================================================
    716 FUNCTION horzcat_s1(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    717   CHARACTER(LEN=*),           TARGET, INTENT(IN) :: s0
     786FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     787  IMPLICIT NONE
     788  CHARACTER(LEN=*),                   INTENT(IN) :: s0
    718789  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    719790  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
    720 !------------------------------------------------------------------------------------------------------------------------------
    721791  CHARACTER(LEN=maxlen), POINTER     :: s
    722   LOGICAL :: lv(10)
    723   INTEGER :: iv
    724   lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
    725          PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
    726   ALLOCATE(out(COUNT(lv)))
    727   DO iv=1, COUNT(lv)
    728     SELECT CASE(iv)
    729       CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
    730       CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
     792  INTEGER                            :: nrow, iv
     793  LOGICAL                            :: pre(9)
     794!------------------------------------------------------------------------------------------------------------------------------
     795  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
     796  nrow = 1+COUNT(pre)
     797  ALLOCATE(out(nrow))
     798  out(1) = s0
     799  DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
     800    SELECT CASE(iv-1)
     801      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
     802      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    731803    END SELECT
    732804    out(iv) = s
    733805  END DO
    734 END FUNCTION horzcat_s1
    735 !==============================================================================================================================
    736 FUNCTION horzcat_sm(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    737   CHARACTER(LEN=*),           TARGET, DIMENSION(:), INTENT(IN) :: s0
    738   CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
     806END FUNCTION horzcat_s00
     807!==============================================================================================================================
     808FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     809  IMPLICIT NONE
     810  CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
     811  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
     812  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
     813  INTEGER :: nc
     814  nc = SIZE(s0)
     815  tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     816  out = [s0(1:nc-1), tmp]
     817END FUNCTION horzcat_s10
     818!==============================================================================================================================
     819FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     820  IMPLICIT NONE
     821  CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
     822  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
    739823  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
    740 !------------------------------------------------------------------------------------------------------------------------------
    741824  CHARACTER(LEN=maxlen), POINTER     :: s(:)
    742   LOGICAL :: lv(10)
    743   INTEGER :: nrow, ncol, iv, n
    744   lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
    745          PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
    746   nrow = SIZE(s0); ncol=COUNT(lv)
     825  INTEGER                            :: nrow, ncol, iv, n
     826  LOGICAL                            :: pre(9)
     827!------------------------------------------------------------------------------------------------------------------------------
     828  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
     829  nrow = SIZE(s0)
     830  ncol = 1+COUNT(pre)
    747831  ALLOCATE(out(nrow, ncol))
    748   DO iv=1, ncol
    749     SELECT CASE(iv)
    750       CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
    751       CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
     832  out(:,1) = s0
     833  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     834    SELECT CASE(iv-1)
     835      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
     836      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    752837    END SELECT
    753838    n = SIZE(s, DIM=1)
    754     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     839    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    755840    out(:,iv) = s(:)
    756841  END DO
    757 END FUNCTION horzcat_sm
    758 !==============================================================================================================================
    759 FUNCTION horzcat_i1(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    760   INTEGER,           TARGET, INTENT(IN) :: i0
     842END FUNCTION horzcat_s11
     843!==============================================================================================================================
     844FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     845  IMPLICIT NONE
     846  CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
     847  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
     848  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
     849  INTEGER :: nc
     850  nc  = SIZE(s0, 2)
     851  tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     852  out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
     853END FUNCTION horzcat_s21
     854!==============================================================================================================================
     855FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     856  IMPLICIT NONE
     857  INTEGER,                   INTENT(IN) :: i0
    761858  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    762859  INTEGER, ALLOCATABLE :: out(:)
    763 !------------------------------------------------------------------------------------------------------------------------------
    764860  INTEGER, POINTER     :: i
    765   LOGICAL :: lv(10)
    766   INTEGER :: iv
    767   lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
    768          PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
    769   ALLOCATE(out(COUNT(lv)))
    770   DO iv=1, COUNT(lv)
    771     SELECT CASE(iv)
    772       CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
    773       CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
     861  INTEGER              :: ncol, iv
     862  LOGICAL              :: pre(9)
     863!------------------------------------------------------------------------------------------------------------------------------
     864  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
     865  ncol = SIZE(pre)
     866  ALLOCATE(out(ncol))
     867  out(1) = i0
     868  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     869    SELECT CASE(iv-1)
     870      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
     871      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    774872    END SELECT
    775873    out(iv) = i
    776874  END DO
    777 END FUNCTION horzcat_i1
    778 !==============================================================================================================================
    779 FUNCTION horzcat_im(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    780   INTEGER,           TARGET, DIMENSION(:), INTENT(IN) :: i0
    781   INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
     875END FUNCTION horzcat_i00
     876!==============================================================================================================================
     877FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     878  IMPLICIT NONE
     879  INTEGER,           INTENT(IN) :: i0(:), i1
     880  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
     881  INTEGER, ALLOCATABLE :: out(:), tmp(:)
     882  INTEGER :: nc
     883  nc = SIZE(i0)
     884  tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     885  out = [i0(1:nc-1), tmp]
     886END FUNCTION horzcat_i10
     887!==============================================================================================================================
     888FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     889  IMPLICIT NONE
     890  INTEGER,                   INTENT(IN) :: i0(:)
     891  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
    782892  INTEGER, ALLOCATABLE :: out(:,:)
    783 !------------------------------------------------------------------------------------------------------------------------------
    784893  INTEGER, POINTER     :: i(:)
    785   LOGICAL :: lv(10)
    786   INTEGER :: nrow, ncol, iv, n
    787   lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
    788          PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
    789   nrow = SIZE(i0); ncol=COUNT(lv)
     894  INTEGER              :: nrow, ncol, iv, n
     895  LOGICAL              :: pre(9)
     896!------------------------------------------------------------------------------------------------------------------------------
     897  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
     898  nrow = SIZE(i0)
     899  ncol = 1+COUNT(pre)
    790900  ALLOCATE(out(nrow, ncol))
    791   DO iv=1, ncol
    792     SELECT CASE(iv)
    793       CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
    794       CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
     901  out(:,1) = i0
     902  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     903    SELECT CASE(iv-1)
     904      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
     905      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    795906    END SELECT
    796907    n = SIZE(i, DIM=1)
    797     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     908    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    798909    out(:,iv) = i(:)
    799910  END DO
    800 END FUNCTION horzcat_im
    801 !==============================================================================================================================
    802 FUNCTION horzcat_r1(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    803   REAL,           TARGET, INTENT(IN) :: r0
     911END FUNCTION horzcat_i11
     912!==============================================================================================================================
     913FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     914  IMPLICIT NONE
     915  INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
     916  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
     917  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
     918  INTEGER :: nc
     919  nc  = SIZE(i0, 2)
     920  tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     921  out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
     922END FUNCTION horzcat_i21
     923!==============================================================================================================================
     924FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     925  IMPLICIT NONE
     926  REAL,                   INTENT(IN) :: r0
    804927  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    805928  REAL, ALLOCATABLE :: out(:)
    806 !------------------------------------------------------------------------------------------------------------------------------
    807929  REAL, POINTER     :: r
    808   LOGICAL :: lv(10)
    809   INTEGER :: iv
    810   lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
    811          PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
    812   ALLOCATE(out(COUNT(lv)))
    813   DO iv=1, COUNT(lv)
    814     SELECT CASE(iv)
    815       CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
    816       CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
     930  INTEGER           :: ncol, iv
     931  LOGICAL           :: pre(9)
     932!------------------------------------------------------------------------------------------------------------------------------
     933  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
     934  ncol = 1+COUNT(pre)
     935  ALLOCATE(out(ncol))
     936  out(1) = r0
     937  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     938    SELECT CASE(iv-1)
     939      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
     940      CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    817941    END SELECT
    818942    out(iv) = r
    819943  END DO
    820 END FUNCTION horzcat_r1
    821 !==============================================================================================================================
    822 FUNCTION horzcat_rm(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    823   REAL,           TARGET, DIMENSION(:), INTENT(IN) :: r0
    824   REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
     944END FUNCTION horzcat_r00
     945!==============================================================================================================================
     946FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     947  IMPLICIT NONE
     948  REAL,           INTENT(IN) :: r0(:), r1
     949  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
     950  REAL, ALLOCATABLE :: out(:), tmp(:)
     951  INTEGER :: nc
     952  nc  = SIZE(r0)
     953  tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     954  out = [r0(1:nc-1), tmp]
     955END FUNCTION horzcat_r10
     956!==============================================================================================================================
     957FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     958  IMPLICIT NONE
     959  REAL,                   INTENT(IN) :: r0(:)
     960  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    825961  REAL, ALLOCATABLE :: out(:,:)
    826 !------------------------------------------------------------------------------------------------------------------------------
    827962  REAL, POINTER     :: r(:)
    828   LOGICAL :: lv(10)
    829   INTEGER :: nrow, ncol, iv, n
    830   lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
    831          PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
    832   nrow = SIZE(r0); ncol=COUNT(lv)
     963  INTEGER           :: nrow, ncol, iv, n
     964  LOGICAL           :: pre(9)
     965!------------------------------------------------------------------------------------------------------------------------------
     966  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
     967  nrow = SIZE(r0)
     968  ncol = 1+COUNT(pre)
    833969  ALLOCATE(out(nrow, ncol))
    834   DO iv=1, ncol
    835     SELECT CASE(iv)
    836       CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
    837       CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
     970  out(:,1) = r0
     971  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     972    SELECT CASE(iv-1)
     973      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
     974      CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    838975    END SELECT
    839976    n = SIZE(r, DIM=1)
    840     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     977    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    841978    out(:,iv) = r(:)
    842979  END DO
    843 END FUNCTION horzcat_rm
    844 !==============================================================================================================================
    845 FUNCTION horzcat_d1(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    846   DOUBLE PRECISION,           TARGET, INTENT(IN) :: d0
     980END FUNCTION horzcat_r11
     981!==============================================================================================================================
     982FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     983  IMPLICIT NONE
     984  REAL,           INTENT(IN) :: r0(:,:), r1(:)
     985  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     986  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
     987  INTEGER :: nc
     988  nc  = SIZE(r0, 2)
     989  tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     990  out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
     991END FUNCTION horzcat_r21
     992!==============================================================================================================================
     993FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     994  IMPLICIT NONE
     995  DOUBLE PRECISION,                   INTENT(IN) :: d0
    847996  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    848997  DOUBLE PRECISION, ALLOCATABLE :: out(:)
    849 !------------------------------------------------------------------------------------------------------------------------------
    850998  DOUBLE PRECISION, POINTER     :: d
    851   LOGICAL :: lv(10)
    852   INTEGER :: iv
    853   lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
    854          PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
    855   ALLOCATE(out(COUNT(lv)))
    856   DO iv=1, COUNT(lv)
    857     SELECT CASE(iv)
    858       CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
    859       CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
     999  INTEGER                       :: ncol, iv
     1000  LOGICAL                       :: pre(9)
     1001!------------------------------------------------------------------------------------------------------------------------------
     1002  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1003  ncol = 1+COUNT(pre)
     1004  ALLOCATE(out(ncol))
     1005  out(1) = d0
     1006  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1007    SELECT CASE(iv-1)
     1008      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
     1009      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    8601010    END SELECT
    8611011    out(iv) = d
    8621012  END DO
    863 END FUNCTION horzcat_d1
    864 !==============================================================================================================================
    865 FUNCTION horzcat_dm(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    866   DOUBLE PRECISION,           TARGET, DIMENSION(:), INTENT(IN) :: d0
    867   DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
     1013END FUNCTION horzcat_d00
     1014!==============================================================================================================================
     1015FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1016  IMPLICIT NONE
     1017  DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
     1018  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
     1019  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
     1020  INTEGER :: nc
     1021  nc = SIZE(d0)
     1022  tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1023  out = [d0(1:nc-1), tmp]
     1024END FUNCTION horzcat_d10
     1025!==============================================================================================================================
     1026FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1027  IMPLICIT NONE
     1028  DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
     1029  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    8681030  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
    869 !------------------------------------------------------------------------------------------------------------------------------
    8701031  DOUBLE PRECISION, POINTER     :: d(:)
    871   LOGICAL :: lv(10)
    872   INTEGER :: nrow, ncol, iv, n
    873   lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
    874          PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
    875   nrow = SIZE(d0); ncol=COUNT(lv)
     1032  INTEGER                       :: nrow, ncol, iv, n
     1033  LOGICAL                       :: pre(9)
     1034!------------------------------------------------------------------------------------------------------------------------------
     1035  nrow = SIZE(d0)
     1036  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1037  ncol = 1+COUNT(pre)
    8761038  ALLOCATE(out(nrow, ncol))
    877   DO iv=1, ncol
    878     SELECT CASE(iv)
    879       CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
    880       CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
     1039  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1040    SELECT CASE(iv-1)
     1041      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
     1042      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    8811043    END SELECT
    8821044    n = SIZE(d, DIM=1)
    883     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     1045    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    8841046    out(:,iv) = d(:)
    8851047  END DO
    886 END FUNCTION horzcat_dm
     1048END FUNCTION horzcat_d11
     1049!==============================================================================================================================
     1050FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1051  IMPLICIT NONE
     1052  DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
     1053  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1054  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
     1055  INTEGER :: nc
     1056  nc  = SIZE(d0, 2)
     1057  tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1058  out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
     1059END FUNCTION horzcat_d21
    8871060!==============================================================================================================================
    8881061
    … …  
    8961069!==============================================================================================================================
    8971070LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
     1071  IMPLICIT NONE
    8981072  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    8991073  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
    … …  
    10041178!==============================================================================================================================
    10051179LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
     1180  IMPLICIT NONE
    10061181  INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
    10071182  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    … …  
    10861261!==============================================================================================================================
    10871262LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
     1263  IMPLICIT NONE
    10881264! Display outliers list in tables
    10891265! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
    … …  
    11151291
    11161292  rk = SIZE(n); nv = SIZE(vnm)
    1117   IF(test(fmsg('SIZE(nam) /= 1 and /= last "n" element', sub, nv /= 1 .AND. nv /= n(rk), unt),lerr)) RETURN
    1118   IF(test(fmsg('ll" and "a" sizes mismatch',             sub, SIZE(a) /= SIZE(ll),       unt),lerr)) RETURN
    1119   IF(test(fmsg('profile "n" does not match "a" and "ll', sub, SIZE(a) /= PRODUCT(n),     unt),lerr)) RETURN
     1293  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
     1294  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
     1295  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
    11201296  CALL msg(mes, sub, unit=unt)
    11211297
    … …  
    11641340!==============================================================================================================================
    11651341LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
     1342  IMPLICIT NONE
    11661343! Display outliers list in tables
    11671344! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
    … …  
    12211398!==============================================================================================================================
    12221399LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
     1400  IMPLICIT NONE
    12231401  CHARACTER(LEN=*),      INTENT(IN)  :: str
    12241402  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
    … …  
    12541432  DO WHILE(nl > 1)
    12551433    i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO
    1256     IF(test(reduceExpr_basic(vl(i+1), v), lerr)) RETURN
     1434    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
    12571435    v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
    12581436    vv = v//REPEAT(' ',768)
    … …  
    12701448!==============================================================================================================================
    12711449LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
     1450  IMPLICIT NONE
    12721451  CHARACTER(LEN=*),      INTENT(IN)  :: str
    12731452  CHARACTER(LEN=*),      INTENT(OUT) :: val
    … …  
    12841463  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
    12851464  s = str
    1286   IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
     1465  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
     1466  IF(lerr) RETURN                                                              !--- Problem with the parsing
    12871467  vl = str2dble(ky)                                                            !--- Conversion to doubles
    12881468  lerr = ANY(vl >= HUGE(1.d0))
    1289   IF(fmsg('Some values are non-numeric in: '//TRIM(s), ll=lerr)) RETURN        !--- Non-numerical values found
     1469  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
     1470  IF(lerr) RETURN                                                              !--- Non-numerical values found
    12901471  DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
    12911472    DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
    … …  
    12931474      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
    12941475      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
    1295       SELECT CASE(op(io))                                                          !--- Perform operation on the two values
     1476      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
    12961477        CASE('^'); v = vm**vp
    12971478        CASE('/'); v = vm/vp
    … …  
    13111492!==============================================================================================================================
    13121493FUNCTION reduceExpr_m(str, val) RESULT(lerr)
     1494  IMPLICIT NONE
    13131495  LOGICAL,               ALLOCATABLE              :: lerr(:)
    13141496  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
    … …  
    13261508!==============================================================================================================================
    13271509ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
     1510  IMPLICIT NONE
    13281511  CHARACTER(LEN=*), INTENT(IN) :: str
    13291512  REAL    :: x
    … …  
    13571540!==============================================================================================================================
    13581541ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
     1542  IMPLICIT NONE
    13591543  CHARACTER(LEN=*), INTENT(IN) :: str
    13601544  INTEGER :: ierr
    … …  
    13641548!==============================================================================================================================
    13651549ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
     1550  IMPLICIT NONE
    13661551  CHARACTER(LEN=*), INTENT(IN) :: str
    13671552  INTEGER :: ierr
    … …  
    13711556!==============================================================================================================================
    13721557ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
     1558  IMPLICIT NONE
    13731559  CHARACTER(LEN=*), INTENT(IN) :: str
    13741560  INTEGER :: ierr
    … …  
    13781564!==============================================================================================================================
    13791565ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
     1566  IMPLICIT NONE
    13801567  LOGICAL, INTENT(IN) :: b
    13811568  WRITE(out,*)b
    … …  
    13841571!==============================================================================================================================
    13851572ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
     1573  IMPLICIT NONE
    13861574  INTEGER,           INTENT(IN) :: i
    13871575  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
    … …  
    13941582!==============================================================================================================================
    13951583ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
     1584  IMPLICIT NONE
    13961585  REAL,                       INTENT(IN) :: r
    13971586  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    … …  
    14031592!==============================================================================================================================
    14041593ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
     1594  IMPLICIT NONE
    14051595  DOUBLE PRECISION,           INTENT(IN) :: d
    14061596  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    … …  
    14121602!==============================================================================================================================
    14131603ELEMENTAL SUBROUTINE cleanZeros(s)
     1604  IMPLICIT NONE
    14141605  CHARACTER(LEN=*), INTENT(INOUT) :: s
    14151606  INTEGER :: ls, ix, i
    … …  
    14291620!==============================================================================================================================
    14301621FUNCTION addQuotes_1(s) RESULT(out)
     1622  IMPLICIT NONE
    14311623  CHARACTER(LEN=*), INTENT(IN)  :: s
    14321624  CHARACTER(LEN=:), ALLOCATABLE :: out
    … …  
    14351627!==============================================================================================================================
    14361628FUNCTION addQuotes_m(s) RESULT(out)
     1629  IMPLICIT NONE
    14371630  CHARACTER(LEN=*), INTENT(IN)  :: s(:)
    14381631  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
    … …  
    14471640!==============================================================================================================================
    14481641ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
     1642  IMPLICIT NONE
    14491643  CHARACTER(LEN=*), INTENT(IN) :: s
    14501644  CHARACTER(LEN=1) :: b, e
    … …  
    14611655!==============================================================================================================================
    14621656LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
     1657  IMPLICIT NONE
    14631658! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
    14641659! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
    … …  
    14831678!==============================================================================================================================
    14841679SUBROUTINE removeComment(str)
     1680  IMPLICIT NONE
    14851681  CHARACTER(LEN=*), INTENT(INOUT) :: str
    14861682  INTEGER :: ix
Note: See TracChangeset for help on using the changeset viewer.