strings_mod.f90 – Fortran Program

Modules

strings_mod
Source Code

MODULE strings_mod

  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: REAL64, REAL32

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: maxlen, init_printout, msg, lunout, prt_level, maxTableWidth
  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, duplicate, cat
  PUBLIC :: dispTable, dispOutliers, dispNameList
  PUBLIC :: is_numeric, num2str, str2bool, str2int, str2real, str2dble
  PUBLIC :: reduceExpr, addQuotes, checkList, removeComment

  INTERFACE num2str;    MODULE PROCEDURE bool2str, int2str, real2str, dble2str;  END INTERFACE num2str
  INTERFACE  msg;       MODULE PROCEDURE        msg_1,                    msg_m; END INTERFACE  msg
  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
  INTERFACE strTail;    MODULE PROCEDURE    strTail_1,                strTail_m; END INTERFACE strTail
  INTERFACE strClean;   MODULE PROCEDURE   strClean_1,               strClean_m; END INTERFACE strClean
  INTERFACE strReduce;  MODULE PROCEDURE  strReduce_1,              strReduce_2; END INTERFACE strReduce
  INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
  INTERFACE cat; MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00, horzcat_d00, horzcat_l00, &
                                   horzcat_s10, horzcat_i10, horzcat_r10, horzcat_d10, horzcat_l10, &
                                   horzcat_s11, horzcat_i11, horzcat_r11, horzcat_d11, horzcat_l11, &
                                   horzcat_s21, horzcat_i21, horzcat_r21, horzcat_d21, horzcat_l21, &
                                   horzcat_s22, horzcat_i22, horzcat_r22, horzcat_d22, horzcat_l22; END INTERFACE cat
  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;           END INTERFACE strFind
  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind;     END INTERFACE find
  INTERFACE duplicate;    MODULE PROCEDURE dupl_s, dupl_i, dupl_r, dupl_l; END INTERFACE duplicate
  INTERFACE dispTable;    MODULE PROCEDURE    dispTable_1,    dispTable_2; END INTERFACE dispTable
  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
  INTERFACE addQuotes;    MODULE PROCEDURE    addQuotes_1,    addQuotes_m; END INTERFACE addQuotes

  INTEGER, PARAMETER :: maxlen    = 256                    !--- Standard maximum length for strings
  INTEGER,      SAVE :: lunout    = 6                      !--- Printing unit  (default: 6, ie. on screen)
  INTEGER,      SAVE :: prt_level = 1                      !--- Printing level (default: 1, ie. print all)
  INTEGER,      SAVE :: maxTableWidth = 192                !--- Default max. number of characters per lines in dispTable

CONTAINS

!==============================================================================================================================
SUBROUTINE init_printout(lunout_, prt_level_)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: lunout_, prt_level_
  lunout    = lunout_
  prt_level = prt_level_
END SUBROUTINE init_printout
!==============================================================================================================================


!==============================================================================================================================
!=== Display one or several messages, one each line, starting with the current routine name "modname".
!==============================================================================================================================
SUBROUTINE msg_1(str, modname, ll, unit)
  IMPLICIT NONE
  !--- Display a simple message "str". Optional parameters:
  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
  !    * "ll":      message trigger ; message is displayed only if ll==.TRUE.
  !    * "unit":    write unit (by default: "lunout")
  CHARACTER(LEN=*),           INTENT(IN) :: str
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
  INTEGER,          OPTIONAL, INTENT(IN) :: unit
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen) :: subn
  INTEGER :: unt
  subn = '';    IF(PRESENT(modname)) subn = modname
  IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
  unt = lunout; IF(PRESENT(unit)) unt = unit
  IF(subn == '') WRITE(unt,'(a)') str                                          !--- Simple message
  IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str                        !--- Routine name provided
END SUBROUTINE msg_1
!==============================================================================================================================
SUBROUTINE msg_m(str, modname, ll, unit, nmax)
  IMPLICIT NONE
  !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
  INTEGER,          OPTIONAL, INTENT(IN) :: unit
  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
  CHARACTER(LEN=maxlen) :: subn
  INTEGER :: unt, nmx, k
  LOGICAL :: l
  subn = '';    IF(PRESENT(modname)) subn = modname
  l   = .TRUE.; IF(PRESENT(ll))     l = ll
  unt = lunout; IF(PRESENT(unit)) unt = unit
  nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
  s = strStackm(str, ', ', nmx)
  DO k=1,SIZE(s); CALL msg_1(s(k), subn,  l,   unt); END DO
END SUBROUTINE msg_m
!==============================================================================================================================


!==============================================================================================================================
!=== Lower/upper case conversion function. ====================================================================================
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: k
  out = str
  DO k=1,LEN_TRIM(str)
    IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
  END DO
END FUNCTION strLower
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: k
  out = str
  DO k=1,LEN_TRIM(str)
    IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
  END DO
END FUNCTION strUpper
!==============================================================================================================================


!==============================================================================================================================
!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str"        ================
!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
!===    * strHead(..,.FALSE.) = 'a'           ${str%%$sep*}                                                    ================
!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
!==============================================================================================================================
CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: str
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
!------------------------------------------------------------------------------------------------------------------------------
  IF(PRESENT(sep)) THEN
    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
  ELSE
    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
  END IF
  IF(out == '') out = str
END FUNCTION strHead_1
!==============================================================================================================================
FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  IF(PRESENT(sep)) THEN
    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep),            k=1, SIZE(str))]
  ELSE
    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'),            k=1, SIZE(str))]
  END IF
END FUNCTION strHead_m
!==============================================================================================================================
!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str"          ================
!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
!===    * strTail(str, '_', .FALSE.) = 'b_c'         ${str#*$sep}                                              ================
!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
!==============================================================================================================================
CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: str
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
!------------------------------------------------------------------------------------------------------------------------------
  IF(PRESENT(sep)) THEN
    IF(     PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep)          +LEN(sep):LEN_TRIM(str))
  ELSE
    IF(     PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/')          +1:LEN_TRIM(str))
  END IF
  IF(out == '') out = str
END FUNCTION strTail_1
!==============================================================================================================================
FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  IF(PRESENT(sep)) THEN
    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep),            k=1, SIZE(str))]
  ELSE
    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'),            k=1, SIZE(str))]
  END IF
END FUNCTION strTail_m
!==============================================================================================================================


!==============================================================================================================================
!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
!==============================================================================================================================
FUNCTION strStack(str, sep, mask) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=:),          ALLOCATABLE :: out
  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  LOGICAL,          OPTIONAL, INTENT(IN) :: mask(:)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=:), ALLOCATABLE :: s
  INTEGER :: is, i0
  IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
  ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
  IF(PRESENT(mask)) THEN
    IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF
    i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO
    out = str(i0); DO is=i0+1,SIZE(str, DIM=1); IF(.NOT.mask(is)) CYCLE; out = TRIM(out)//s//TRIM(str(is)); END DO
  ELSE
    out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
  END IF
END FUNCTION strStack
!==============================================================================================================================
!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
!==============================================================================================================================
FUNCTION strStackm(str, sep, nmax) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
  CHARACTER(LEN=maxlen) :: sp
  INTEGER :: is, ns, no, mx, n
  IF(SIZE(str) == 0) THEN; out = ['']; RETURN; END IF
  sp =', '; IF(PRESENT(sep )) sp = sep
  ns = 2  ; IF(PRESENT(sep )) ns = LEN(sep)
  mx = 256; IF(PRESENT(nmax)) mx = nmax
  no = 1; out = ['']
  DO is = 1, SIZE(str)
    n = LEN_TRIM(str(is)); IF(out(no)/='') n = n+ns+LEN_TRIM(out(no))          !--- Line length after "str(is)" inclusion
    IF(out(no) == '') THEN
      out(no) = str(is)                                                        !--- Empty new line: set to "str(is)"
    ELSE IF(n <= mx) THEN
      out(no) = TRIM(out(no))//sp(1:ns)//TRIM(str(is))                         !--- Append "str(is)" to the current line
    ELSE
      ALLOCATE(t(no+1)); t(1:no) = out; no=no+1; t(no) = str(is)               !--- Full line: "str(si)" put in next line
      CALL MOVE_ALLOC(FROM=t, TO=out)
    END IF
  END DO
END FUNCTION strStackm
!==============================================================================================================================


!==============================================================================================================================
!=== String cleaning: replace tabulation by spaces, remove NULL characters and comments. ======================================
!==============================================================================================================================
SUBROUTINE strClean_1(str)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(INOUT) :: str
  INTEGER :: k, n, m
  n = LEN(str)
  DO k = n, 1, -1
    m = IACHAR(str(k:k))
    IF(m==9) str(k:k) = ' '                           !--- Replace the tabulations with spaces
    IF(m==0) str(k:n) = str(k+1:n)//' '               !--- Remove the NULL characters
  END DO
  m = INDEX(str,'!')-1; IF(m==-1) m = LEN_TRIM(str)   !--- Remove end of line comment
  str = ADJUSTL(str(1:m))
END SUBROUTINE strClean_1
!==============================================================================================================================
SUBROUTINE strClean_m(str)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
  INTEGER :: k
  DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
END SUBROUTINE strClean_m
!==============================================================================================================================


!==============================================================================================================================
!=== strReduce_1(str1)     : Remove duplicated elements of str1.    ===========================================================
!=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
!==============================================================================================================================
SUBROUTINE strReduce_1(str, nb)
  IMPLICIT NONE
  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
  INTEGER :: k, n, n1
  IF(PRESENT(nb)) nb = 0
  CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
  n1 = SIZE(s1, DIM=1)                                     !--- Total nb. of elements in "s1"
  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
  ALLOCATE(str(n))
  IF(n==0) RETURN
  str(1) = s1(1)
  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str(n)=s1(k); END DO
  IF(PRESENT(nb)) nb=n
END SUBROUTINE strReduce_1
!==============================================================================================================================
SUBROUTINE strReduce_2(str1, str2)
  IMPLICIT NONE
  CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
  INTEGER :: k
  IF(SIZE(str2)==0) RETURN
  s2 = str2; CALL strClean(s2)
  IF(.NOT.ALLOCATED(s2)) RETURN
  IF(SIZE(s2) == 0) THEN; DEALLOCATE(s2); RETURN; END IF
  IF(.NOT.ALLOCATED(str1)) THEN
    str1 = s2
  ELSE IF(SIZE(str1)==0) THEN
    str1 = s2
  ELSE
    s1 = str1; CALL strClean(s1)
    str1 = [s1, PACK(s2, MASK= [( ALL(s1(:) /= s2(k)), k=1, SIZE(s2) )] ) ]
  END IF
END SUBROUTINE strReduce_2
!==============================================================================================================================


!==============================================================================================================================
!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
!==============================================================================================================================
INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str(:), s
  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
  IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
END FUNCTION strIdx_1
!==============================================================================================================================
FUNCTION strIdx_m(str, s, n) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
  IF(PRESENT(n)) n = COUNT(out(:)/=0)
END FUNCTION strIdx_m
!==============================================================================================================================


!==============================================================================================================================
!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
!==============================================================================================================================
FUNCTION strFind_1(str, s, n) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
END FUNCTION strFind_1
!==============================================================================================================================
FUNCTION strFind_m(str, s, n) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
END FUNCTION strFind_m
!==============================================================================================================================
FUNCTION intFind_1(i,j,n) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN)  :: i(:), j
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
END FUNCTION intFind_1
!==============================================================================================================================
FUNCTION intFind_m(i,j,n) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN)  :: i(:), j(:)
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
END FUNCTION intFind_m
!==============================================================================================================================
FUNCTION booFind(l,n) RESULT(out)
   IMPLICIT NONE
   LOGICAL,           INTENT(IN)  :: l(:)
  INTEGER, OPTIONAL, INTENT(OUT) :: n
  INTEGER,           ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k
  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
END FUNCTION booFind
!==============================================================================================================================


!==============================================================================================================================
!=== DUPLICATE A VECTOR "v(:)" "n" times ======================================================================================
!==============================================================================================================================
SUBROUTINE dupl_s(v, n, vdup)
  CHARACTER(LEN=*),                   INTENT(IN)  :: v(:)
  INTEGER,                            INTENT(IN)  :: n
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vdup(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: nv, i
  nv = SIZE(v)
  ALLOCATE(vdup(n*nv))
  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
END SUBROUTINE dupl_s
!==============================================================================================================================
SUBROUTINE dupl_i(v, n, vdup)
  INTEGER,              INTENT(IN)  :: v(:)
  INTEGER,              INTENT(IN)  :: n
  INTEGER, ALLOCATABLE, INTENT(OUT) :: vdup(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: nv, i
  nv = SIZE(v)
  ALLOCATE(vdup(n*nv))
  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
END SUBROUTINE dupl_i
!==============================================================================================================================
SUBROUTINE dupl_r(v, n, vdup)
  REAL,                 INTENT(IN)  :: v(:)
  INTEGER,              INTENT(IN)  :: n
  REAL,    ALLOCATABLE, INTENT(OUT) :: vdup(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: nv, i
  nv = SIZE(v)
  ALLOCATE(vdup(n*nv))
  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
END SUBROUTINE dupl_r
!==============================================================================================================================
SUBROUTINE dupl_l(v, n, vdup)
  LOGICAL,              INTENT(IN)  :: v(:)
  INTEGER,              INTENT(IN)  :: n
  LOGICAL, ALLOCATABLE, INTENT(OUT) :: vdup(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: nv, i
  nv = SIZE(v)
  ALLOCATE(vdup(n*nv))
  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
END SUBROUTINE dupl_l
!==============================================================================================================================


!==============================================================================================================================
!=== GET THE INDEX IN "rawList" OF THE 1ST APPEARANCE OF ONE OF THE "del(:)" SEPARATORS (0 IF NONE OF THEM ARE PRESENT)
!===  IF lSc == .TRUE.:  * SKIP HEAD SIGNS OR EXPONENTS SIGNS THAT SHOULD NOT BE CONFUSED WITH SEPARATORS
!===                     * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
!==============================================================================================================================
LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
  INTEGER,           INTENT(IN)  :: ibeg                             !--- Start index
  INTEGER,           INTENT(OUT) :: idx                              !--- Index of the first identified delimiter in "rawList"
  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
  lerr = .FALSE.
  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList" 
  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished

  !=== No delimiter found: the whole string must be a valid number
  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- String must be a number
    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
  END IF

  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number

  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
  IF(idx == 0) THEN
    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- No other delimiter: whole string must be a valid numb
    IF(lerr) idx = idx0; RETURN
  END IF
  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))

CONTAINS

!------------------------------------------------------------------------------------------------------------------------------
INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
!--- "id" is the index in "del(:)" of the first delimiter found.
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
  INTEGER,           INTENT(IN)  :: ib
  INTEGER,           INTENT(OUT) :: id
!------------------------------------------------------------------------------------------------------------------------------
  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
  IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
END FUNCTION strIdx1

END FUNCTION strIdx_prv
!==============================================================================================================================


!==============================================================================================================================
!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
!==============================================================================================================================
LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
  INTEGER,           INTENT(OUT) :: nb
  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
!------------------------------------------------------------------------------------------------------------------------------
  LOGICAL :: ll
  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
  lerr = strCount_1m(rawList, [delimiter], nb, ll)
END FUNCTION strCount_11
!==============================================================================================================================
LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
!------------------------------------------------------------------------------------------------------------------------------
  LOGICAL :: ll
  INTEGER :: id
  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
  lerr = .TRUE.
  ALLOCATE(nb(SIZE(rawList)))
  DO id = 1, SIZE(rawList)
    lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
  END DO
END FUNCTION strCount_m1
!==============================================================================================================================
LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
  INTEGER,           INTENT(OUT) :: nb
  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER              :: ib, ie, jd, nr
  LOGICAL              :: ll
  CHARACTER(LEN=1024)  :: r
  lerr = .FALSE.
  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
  r  = TRIM(ADJUSTL(rawList))
  nr = LEN_TRIM(r); IF(nr == 0) RETURN
  nb = 1; ib = 1
  DO
    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
    CALL msg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll = lerr); IF(lerr) RETURN
    IF(ie == 0 .OR. jd == 0) EXIT
    ib = ie + LEN(delimiter(jd))
    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
    nb = nb + 1
  END DO
END FUNCTION strCount_1m
!==============================================================================================================================


!==============================================================================================================================
!=== Purpose: Parse "delimiter"-separated list "rawList" into the pair keys(:), vals(:).   ====================================
!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
!==============================================================================================================================
LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=1024) :: r
  INTEGER :: nr, nk
  lerr = .FALSE.
  r  = TRIM(ADJUSTL(rawList))
  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
  nk = countK()                                                      !--- COUNT THE ELEMENTS
  CALL parseK(keys)                                                  !--- PARSE THE KEYS
  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS

CONTAINS

!------------------------------------------------------------------------------------------------------------------------------
INTEGER FUNCTION countK() RESULT(nkeys)
!--- Get the number of elements after parsing.
  IMPLICIT NONE
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: ib, ie, nl
  nkeys = 1; ib = 1; nl = LEN(delimiter)
  DO
    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
    IF(ie == ib-1) EXIT
    ib = ie + nl
    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
      ib = ib + 1
    END DO     !--- Skip spaces before next chain
    nkeys = nkeys+1
  END DO
END FUNCTION countK

!------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE parseK(keys)
!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
  IMPLICIT NONE
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: ib, ie, ik
  ALLOCATE(keys(nk))
  ib = 1
  DO ik = 1, nk
    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
    IF(ie == ib-1) EXIT
    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
    ib = ie + LEN(delimiter)
    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
  END DO
  keys(ik) = r(ib:nr)                                                !--- Get the last key
END SUBROUTINE parseK

!------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE parseV(vals)
!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
  IMPLICIT NONE
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen) :: key
  INTEGER :: ik, ix
  ALLOCATE(vals(nk))
  DO ik = 1, nk; key = keys(ik)
    vals(ik) = ''
    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
    keys(ik) = ADJUSTL(key(1:ix-1))
  END DO
END SUBROUTINE parseV

END FUNCTION strParse
!==============================================================================================================================
LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=1024) :: r
  INTEGER :: nr, ik, nk, ib, ie, jd
  LOGICAL :: ll
  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
  lerr = strCount_1m(rawList, delimiter, nk, ll)
  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN

  !--- FEW ALLOCATIONS
  ALLOCATE(keys(nk))
  IF(PRESENT(vals)) ALLOCATE(vals(nk))
  IF(PRESENT(id))   ALLOCATE(id(nk-1))
  IF(PRESENT(n)) n = nk

  !--- PARSING
  r  = TRIM(ADJUSTL(rawList))
  nr = LEN_TRIM(r); IF(nr == 0) RETURN
  ib = 1
  DO ik = 1, nk-1
    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
    keys(ik) = r(ib:ie-1)
    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
    IF(PRESENT(id  )) id(ik) = jd                                    !--- Index in "delimiter(:)" of the "ik"th delimiter
    ib = ie + LEN_TRIM( delimiter(jd) )                              !--- Length of the current delimiter
    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
  END DO
  keys(nk) = r(ib:nr)
  IF(PRESENT(vals)) CALL parseKeys(keys(nk), vals(nk))               !--- Parse a <key>=<val> pair

CONTAINS

!------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE parseKeys(key, val)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(INOUT) :: key
  CHARACTER(LEN=*), INTENT(OUT)   :: val
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: ix
  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
  key = ADJUSTL(key(1:ix-1))
END SUBROUTINE parseKeys

END FUNCTION strParse_m    
!==============================================================================================================================


!==============================================================================================================================
!=== String substitution: replace "key" by "val" each time it appears in "str".
!==============================================================================================================================
SUBROUTINE strReplace_1(str, key, val, lsurr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: i0, ix, nk, ns
  LOGICAL :: lsur, lb, le
  lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
  nk = LEN_TRIM(key)
  i0 = 1
  DO
    ns = LEN_TRIM(str)
    ix = INDEX(str(i0:ns), TRIM(key))            !--- First appearance index of "key" in "s", starting from index "i0"
    IF(ix == 0) EXIT
    ix = ix + i0 -1
    IF(lsur) THEN                                !--- Key must be surrounded by special characters
      !--- lb=.TRUE.: key is at the very beginning of "str" or located after  a special character
      lb = ix     ==1;  IF(.NOT.lb) lb = INDEX('+-*/()^', str(ix-1 :ix-1 ))/=0
      !--- le=.TRUE.: key is at the very end       of "str" or located before a special character
      le = ix+nk-1==ns; IF(.NOT.le) le = INDEX('+-*/()^', str(ix+nk:ix+nk))/=0
      IF(.NOT.(lb.AND.le)) THEN; i0 = i0 + nk; CYCLE; END IF
    END IF
    str = str(1:ix-1)//TRIM(val)//str(ix+nk:ns)
  END DO
END SUBROUTINE strReplace_1
!==============================================================================================================================
SUBROUTINE strReplace_m(str, key, val, lsurr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
  INTEGER :: k
  LOGICAL :: ll
  ll=.FALSE.; IF(PRESENT(lsurr)) ll=lsurr
  DO k=1, SIZE(str); CALL strReplace_1(str(k),key,val,ll); END DO
END SUBROUTINE strReplace_m
!==============================================================================================================================


!==============================================================================================================================
!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
!==============================================================================================================================
FUNCTION horzcat_s00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: v0
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
  INTEGER                            :: ncol, iv, i
  LOGICAL                            :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  ALLOCATE(out(ncol))
  out(1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_s00
!==============================================================================================================================
FUNCTION horzcat_s10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: v0(:), v1
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
  tmp = horzcat_s00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = [v0 , tmp]
END FUNCTION horzcat_s10
!==============================================================================================================================
FUNCTION horzcat_s11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: v0(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
  INTEGER :: nrow, ncol, iv, i
  LOGICAL :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  nrow = SIZE(v0)
  ncol = 1+COUNT(pre)
  IF(pre(1)) nrow = MAX(nrow,SIZE(v1)); IF(pre(2)) nrow = MAX(nrow,SIZE(v2)); IF(pre(3)) nrow = MAX(nrow,SIZE(v3))
  IF(pre(4)) nrow = MAX(nrow,SIZE(v4)); IF(pre(5)) nrow = MAX(nrow,SIZE(v5)); IF(pre(6)) nrow = MAX(nrow,SIZE(v6))
  IF(pre(7)) nrow = MAX(nrow,SIZE(v7)); IF(pre(8)) nrow = MAX(nrow,SIZE(v8)); IF(pre(9)) nrow = MAX(nrow,SIZE(v9))
  ALLOCATE(out(nrow, ncol)); out(:,:) = ''
  out(1:SIZE(v0),1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(1:SIZE(v1),i) = v1; CASE(2); out(1:SIZE(v2),i) = v2; CASE(3); out(1:SIZE(v3),i) = v3
        CASE(4); out(1:SIZE(v4),i) = v4; CASE(5); out(1:SIZE(v5),i) = v5; CASE(6); out(1:SIZE(v5),i) = v6
        CASE(7); out(1:SIZE(v7),i) = v7; CASE(8); out(1:SIZE(v8),i) = v8; CASE(9); out(1:SIZE(v9),i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_s11
!==============================================================================================================================
FUNCTION horzcat_s21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: v0(:,:), v1(:)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
  tmp = horzcat_s11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = horzcat_s22(v0, tmp)
END FUNCTION horzcat_s21
!==============================================================================================================================
FUNCTION horzcat_s22(v0, v1) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: v0(:,:), v1(:,:)
  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), pk(:), pk0(:), pk1(:), tmp(:,:)
  INTEGER :: n0, n1, nrow
  n0 = SIZE(v0,1)
  n1 = SIZE(v1,1)
  nrow = MAX(n0, n1)
  IF(n0 == n1) THEN
     pk0 = PACK(v0, .TRUE.); pk1 = PACK(v1, .TRUE.); pk = [pk0, pk1]
  ELSE IF(n0 /= nrow) THEN
     ALLOCATE(tmp(nrow,SIZE(v0,2))); tmp(:,:) = ''; tmp(1:n0,:) = v0(:,:); pk0 = PACK(tmp, .TRUE.); pk1 = PACK(v1, .TRUE.); pk = [pk0, pk1]
  ELSE
     ALLOCATE(tmp(nrow,SIZE(v1,2))); tmp(:,:) = ''; tmp(1:n1,:) = v1(:,:); pk0 = PACK(tmp, .TRUE.); pk1 = PACK(v1, .TRUE.); pk = [pk0, pk1]
  END IF
  out = RESHAPE(pk, SHAPE=[nrow, SIZE(v0, 2) + SIZE(v1, 2)])
END FUNCTION horzcat_s22
!==============================================================================================================================
FUNCTION horzcat_i00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: v0
  INTEGER, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
  INTEGER, ALLOCATABLE :: out(:)
  INTEGER              :: ncol, iv, i
  LOGICAL              :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  ALLOCATE(out(ncol))
  out(1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_i00
!==============================================================================================================================
FUNCTION horzcat_i10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: v0(:), v1
  INTEGER, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
  INTEGER, ALLOCATABLE :: out(:), tmp(:)
  tmp = horzcat_i00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = [v0, tmp]
END FUNCTION horzcat_i10
!==============================================================================================================================
FUNCTION horzcat_i11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: v0(:)
  INTEGER, OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  INTEGER, ALLOCATABLE :: out(:,:)
  INTEGER :: siz(9), nrow, ncol, iv, i, n
  LOGICAL :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  nrow = SIZE(v0)
  ncol = 1+COUNT(pre)
  ALLOCATE(out(nrow, ncol))
  out(:,1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
     END SELECT
     IF(n /= nrow) THEN; CALL msg("Can't concatenate integer vectors of differing lengths"); STOP; END IF
     SELECT CASE(iv-1)
        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_i11
!==============================================================================================================================
FUNCTION horzcat_i21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: v0(:,:), v1(:)
  INTEGER, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
  tmp = horzcat_i11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = horzcat_i22(v0, tmp)
END FUNCTION horzcat_i21
!==============================================================================================================================
FUNCTION horzcat_i22(v0, v1) RESULT(out)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: v0(:,:), v1(:,:)
  INTEGER, ALLOCATABLE :: out(:,:), pk(:)
  INTEGER :: nrow, ncol
  nrow = SIZE(v0,1)
  ncol = SIZE(v0,2)+SIZE(v1,2)
  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate integer arrays of differing rows numbers"); STOP; END IF
  ALLOCATE(out(nrow, ncol))
  pk =      PACK(v0, .TRUE.)
  pk = [pk, PACK(v1, .TRUE.)]
  out = RESHAPE(pk, SHAPE=[nrow, ncol])
END FUNCTION horzcat_i22
!==============================================================================================================================
FUNCTION horzcat_r00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32),           INTENT(IN) :: v0
  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
  REAL(KIND=REAL32), ALLOCATABLE :: out(:)
  INTEGER           :: ncol, iv, i
  LOGICAL           :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  ALLOCATE(out(ncol))
  out(1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_r00
!==============================================================================================================================
FUNCTION horzcat_r10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32),           INTENT(IN) :: v0(:), v1
  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
  REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
  tmp = horzcat_r00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = [v0 , tmp]
END FUNCTION horzcat_r10
!==============================================================================================================================
FUNCTION horzcat_r11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32),           INTENT(IN) :: v0(:)
  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
  INTEGER :: siz(9), nrow, ncol, iv, i, n
  LOGICAL :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  nrow = SIZE(v0)
  ncol = 1+COUNT(pre)
  ALLOCATE(out(nrow, ncol))
  out(:,1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
     END SELECT
     IF(n /= nrow) THEN; CALL msg("Can't concatenate real vectors of differing lengths"); STOP; END IF
     SELECT CASE(iv-1)
        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_r11
!==============================================================================================================================
FUNCTION horzcat_r21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32),           INTENT(IN) :: v0(:,:), v1(:)
  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
  tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = horzcat_r22(v0, tmp)
END FUNCTION horzcat_r21
!==============================================================================================================================
FUNCTION horzcat_r22(v0, v1) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32), INTENT(IN) :: v0(:,:), v1(:,:)
  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), pk(:)
  INTEGER :: nrow, ncol
  nrow = SIZE(v0,1)
  ncol = SIZE(v0,2)+SIZE(v1,2)
  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate real arrays of differing rows numbers"); STOP; END IF
  ALLOCATE(out(nrow, ncol))
  pk =      PACK(v0, .TRUE.)
  pk = [pk, PACK(v1, .TRUE.)]
  out = RESHAPE(pk, SHAPE=[nrow, ncol])
END FUNCTION horzcat_r22
!==============================================================================================================================
FUNCTION horzcat_d00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64),           INTENT(IN) :: v0
  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
  REAL(KIND=REAL64), ALLOCATABLE :: out(:)
  INTEGER                       :: ncol, iv, i
  LOGICAL                       :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  ALLOCATE(out(ncol))
  out(1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_d00
!==============================================================================================================================
FUNCTION horzcat_d10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64),           INTENT(IN) :: v0(:), v1
  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
  REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
  tmp = horzcat_d00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = [v0 , tmp]
END FUNCTION horzcat_d10
!==============================================================================================================================
FUNCTION horzcat_d11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64),           INTENT(IN) :: v0(:)
  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
  INTEGER :: siz(9), nrow, ncol, iv, i, n
  LOGICAL :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  nrow = SIZE(v0)
  ncol = 1+COUNT(pre)
  ALLOCATE(out(nrow, ncol))
  out(:,1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
     END SELECT
     IF(n /= nrow) THEN; CALL msg("Can't concatenate double vectors of differing lengths"); STOP; END IF
     SELECT CASE(iv-1)
        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_d11
!==============================================================================================================================
FUNCTION horzcat_d21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64),           INTENT(IN) :: v0(:,:), v1(:)
  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
  tmp = horzcat_d11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = horzcat_d22(v0, tmp)
END FUNCTION horzcat_d21
!==============================================================================================================================
FUNCTION horzcat_d22(v0, v1) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64), INTENT(IN) :: v0(:,:), v1(:,:)
  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), pk(:)
  INTEGER :: nrow, ncol
  nrow = SIZE(v0,1)
  ncol = SIZE(v0,2)+SIZE(v1,2)
  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate double arrays of differing rows numbers"); STOP; END IF
  ALLOCATE(out(nrow, ncol))
  pk =      PACK(v0, .TRUE.)
  pk = [pk, PACK(v1, .TRUE.)]
  out = RESHAPE(pk, SHAPE=[nrow, ncol])
END FUNCTION horzcat_d22
!==============================================================================================================================
FUNCTION horzcat_l00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  LOGICAL,           INTENT(IN) :: v0
  LOGICAL, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
  LOGICAL, ALLOCATABLE :: out(:)
  INTEGER              :: ncol, iv, i
  LOGICAL              :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  ALLOCATE(out(ncol))
  out(1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     END SELECT
  i = i+1
  END DO
END FUNCTION horzcat_l00
!==============================================================================================================================
FUNCTION horzcat_l10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  LOGICAL,           INTENT(IN) :: v0(:), v1
  LOGICAL, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
  LOGICAL, ALLOCATABLE :: out(:), tmp(:)
  tmp = horzcat_l00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = [v0, tmp]
END FUNCTION horzcat_l10
!==============================================================================================================================
FUNCTION horzcat_l11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  LOGICAL,           INTENT(IN) :: v0(:)
  LOGICAL, OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  LOGICAL, ALLOCATABLE :: out(:,:)
  INTEGER :: siz(9), nrow, ncol, iv, i, n
  LOGICAL :: pre(9)
!------------------------------------------------------------------------------------------------------------------------------
  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
  ncol = 1+COUNT(pre)
  nrow = SIZE(v0)
  ALLOCATE(out(nrow, ncol))
  out(:,1) = v0
  i = 2
  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     SELECT CASE(iv-1)
        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
     END SELECT
     IF(n /= nrow) THEN; CALL msg("Can't concatenate logical vectors of differing lengths"); STOP; END IF
     SELECT CASE(iv-1)
        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     END SELECT
     i = i+1
  END DO
END FUNCTION horzcat_l11
!==============================================================================================================================
FUNCTION horzcat_l21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
  IMPLICIT NONE
  LOGICAL,           INTENT(IN) :: v0(:,:), v1(:)
  LOGICAL, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
  LOGICAL, ALLOCATABLE :: out(:,:), tmp(:,:)
  tmp = horzcat_l11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
  out = horzcat_l22(v0, tmp)
END FUNCTION horzcat_l21
!==============================================================================================================================
FUNCTION horzcat_l22(v0, v1) RESULT(out)
  IMPLICIT NONE
  LOGICAL, INTENT(IN) :: v0(:,:), v1(:,:)
  LOGICAL, ALLOCATABLE :: out(:,:), pk(:)
  INTEGER :: nrow, ncol
  nrow = SIZE(v0,1)
  ncol = SIZE(v0,2)+SIZE(v1,2)
  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate logical arrays of differing rows numbers"); STOP; END IF
  ALLOCATE(out(nrow, ncol))
  pk =      PACK(v0, .TRUE.)
  pk = [pk, PACK(v1, .TRUE.)]
  out = RESHAPE(pk, SHAPE=[nrow, ncol])
END FUNCTION horzcat_l22
!==============================================================================================================================


!==============================================================================================================================
!=== DISPLAY A TABLE COMPOSED OF HORIZONTALLY CONCATENATED COLUMN VECTORS =====================================================
!==============================================================================================================================
!=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display.
!===  * nRowMax lines are displayed (default: all lines)
!===  * nColMax characters (default: as long as needed) are displayed at most on a line.
!===     - narrow tables are stacked horizontally as much as possible (ie: total width must stay lower than nColMax) .
!===     - wide tables are cut into several sub-tables of columns subsets, with the first nHead columns repeated.
!===  * titles can be a vector (one element each column) or an array (dim 1: number of lines ; dim 2: number of columns)
!==============================================================================================================================
LOGICAL FUNCTION dispTable_1(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN)  :: p                       !--- DISPLAY MAP: s/i/r
  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)               !--- TITLES (one each column, single line)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)                  !--- STRINGS
  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)                  !--- INTEGERS
  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)                  !--- REALS
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt                    !--- Format for reals
  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Display at most "nRowMax" rows
  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Display at most "nColMax" characters each line
  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Head columns repeated for multiple tables display
  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit (default: screen)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub                     !--- Subroutine name
!------------------------------------------------------------------------------------------------------------------------------
  lerr = dispTable_2(p, RESHAPE(titles, [1,SIZE(titles)]), s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub)
END FUNCTION dispTable_1
!==============================================================================================================================
LOGICAL FUNCTION dispTable_2(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN)  :: p                       !--- DISPLAY MAP: s/i/r
  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:,:)             !--- TITLES (one each column, possibly more than one line)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)                  !--- STRINGS
  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)                  !--- INTEGERS
  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)                  !--- REALS
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt                    !--- Format for reals
  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Display at most "nRowMax" rows
  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Display at most "nColMax" characters each line
  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Head columns repeated for multiple tables display
  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit (default: screen)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub                     !--- Subroutine name
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER, PARAMETER :: nm = 1
  INTEGER, ALLOCATABLE :: n(:), nmx(:)
  INTEGER :: nRmx, nCmx, nHd, unt, ib, ic, ie, it, nt, ncol, k, l, l0
  CHARACTER(LEN=maxlen), ALLOCATABLE :: c(:,:), c1(:,:), m(:)
  CHARACTER(LEN=maxlen) :: subn

  !=== CONVERT THE ELEMENTS INTO A STRINGS ARRAY
  lerr = convertTable(p, titles, c, s, i, r, rFmt, sub); IF(lerr) RETURN

  !=== GET VALUES FOR REMAINING OPTIONAL ARGUMENTS
  nRmx= SIZE(c, 1);    IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)   !--- Maximum number of lines to print
  nCmx= maxTableWidth; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)   !--- Maximum number of characters each line
  nHd = 0;             IF(PRESENT(nHead))   nHd = nHead              !--- Number of front columns to duplicate
  unt = lunout;        IF(PRESENT(unit))    unt = unit               !--- Unit to print messages
  subn= 'dispTable';   IF(PRESENT(sub))     subn= sub                !--- Calling subroutine name

  !=== SMALL WIDTH TABLE: STACK AS MUCH VERTICAL SECTIONS HORIZONTALLY AS POSSIBLE CONSIDERING nColMax. UNTOUCHED OTHERWISE.
  n  = tableCellsWidth(c)+2*nm
  c1 = gatherTable(c, n, SIZE(titles, 1), nRmx, nCmx, subn)
  ncol = SIZE(c1, DIM=2)
  IF(ncol /= SIZE(c,2)) n = tableCellsWidth(c1)+2*nm                 !--- UPDATE "n(:)" IF "c" HAS BEEN STACKED

  !=== HIGH WIDTH TABLE: CUT IT INTO SUB-TABLES, WITH THE FIRST "nHead" COLUMNS REPEATED IN EACH OF THEM
  !--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts)
  IF(SUM(n+1)-1 > nCmx .AND. ncol > 1) THEN
     l0 = 1 + LEN_TRIM(subn) + SUM(n(1:nHd)+1)

     !=== DETERMINE THE NUMBER "nt" OF SUB-TABLES
     nt=1; l=l0; DO ic = nHd+1, ncol; IF(l+n(ic)+1 >= nCmx) THEN; l=l0; nt=nt+1;               END IF; l = l+n(ic)+1; END DO

     !=== GET THE INDEX OF THE LAST COLUMN FOR EACH SUB-TABLE
     ALLOCATE(nmx(nt))
     it=0; l=l0; DO ic = nHd+1, ncol; IF(l+n(ic)+1 >= nCmx) THEN; l=l0; it=it+1; nmx(it)=ic-1; END IF; l = l+n(ic)+1; END DO
     nmx(nt) = ncol

     !=== DISPLAY THE SUB-TABLES
     DO it = 1, nt
        ie = nmx(it); ib = nHd+1; IF(it > 1) ib = nmx(it-1)+1
        m = buildTable(cat(c1(:,1:nHd),c1(:,ib:ie)), nm, SIZE(titles, 1))
        DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO; CALL msg('', subn, unit=unt)
     END DO
  ELSE
     !=== DISPLAY THE SINGLE TABLE
     m  = buildTable(c1, nm, SIZE(titles,1))
     DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO
  END IF

CONTAINS

FUNCTION tableCellsWidth(t) RESULT(n)  !=== COMPUTE FOR EACH COLUMN THE MIMIMUM WIDTH TO DISPLAY ELEMENTS WITHOUT TRUNCATION
  CHARACTER(LEN=*), INTENT(IN) :: t(:,:)
  INTEGER, ALLOCATABLE :: n(:)
  INTEGER :: i, j, nr, nc
  INTEGER, ALLOCATABLE :: trimmed_len(:)
  nr = SIZE(t,1)
  nc = SIZE(t,2)
  ALLOCATE(n(nc))
  DO j = 1, nc
     ALLOCATE(trimmed_len(nr))
     DO i = 1, nr
        trimmed_len(i) = LEN_TRIM(t(i, j))
     END DO
     n(j) = MAXVAL(trimmed_len)
     DEALLOCATE(trimmed_len)
  END DO
END FUNCTION tableCellsWidth

END FUNCTION dispTable_2
!==============================================================================================================================


!==============================================================================================================================
!--- Concatenate horizontally the table d0(:,:) so that:
!===  * total width (number of characters per line) remains lower than nColMax (default: 256 characters)
!===  * total number of lines remains lower than nRowMax                       (default: all lines are kept)
!=== If the table d0 starts with nTitle /= 0 lines for titles, they are duplicated at each section top.
!==============================================================================================================================
FUNCTION gatherTable(d0, n, nTitle, nRowMax, nColMax, sub) RESULT(d1)
  IMPLICIT NONE
  CHARACTER(LEN=*),           INTENT(IN) :: d0(:,:)        !--- Input strings array
  INTEGER,                    INTENT(IN) :: n(:)           !--- Maximum width of elements in each column (excluding separator)
  INTEGER,          OPTIONAL, INTENT(IN) :: nTitle         !--- Number of rows for titles
  INTEGER,          OPTIONAL, INTENT(IN) :: nRowMax        !--- Maximum number of rows
  INTEGER,          OPTIONAL, INTENT(IN) :: nColMax        !--- Maximum number of characters each line
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub            !--- Subroutine name
  CHARACTER(LEN=maxlen),     ALLOCATABLE :: d1(:,:)        !--- Array of horizontally gathered sections
  INTEGER :: nr0, nc0, nr1, nc1                            !--- Row and columns numbers for original and gathered array
  INTEGER :: ih, nh, nv                                    !--- Index and number of stacked sections
  INTEGER :: nttl, nrMx, ncMx                              !--- Titles number and effective max. row and columns numbers
  INTEGER :: nrem, nr, ir0, icb, ice
  nr0 = SIZE(d0, DIM=1)
  nc0 = SIZE(d0, DIM=2)
  nttl = 0;   IF(PRESENT(nTitle))  nttl = nTitle
  ncMx = 256; IF(PRESENT(nColMax)) ncMx = MIN(nCmx, nColMax)
  nrMx = nr0; IF(PRESENT(nRowMax)) nrMx = MIN(nrMx, nRowMax)
  nh = MAX(1, ncMx/SUM(n+1))                               !--- Max. horiz. stackabled sections for ncMx (+1: last separator)
  nv = 1+(nr0-nttl-1)/nh                                   !--- Corresponding number ofvertical elements per section
  nh = 1+(nr0-nttl-1)/nv                                   !--- Effective number of sections
  nr1 = MIN(nrMx,1+ nttl+(nr0-nttl-1)/nh); nc1 = nc0*nh    !--- Shape of the stacked array
  ALLOCATE(d1(nr1,nc1))
  nrem = nr0                                               !--- Remaining values to fill in
  DO ih = 1, nh
     nr = MAX(0,MIN(nr1,nrem)-nttl); nrem=nrem-nr          !--- Number of copied rows in ith section (excluding titles)
     ir0 = nttl+(ih-1)*(nr1-nttl)                          !--- Row start index in d1
     ice = ih*nc0; icb = ice-nc0+1                         !--- Column end and start indices in d1
     d1(1:nttl,        icb:ice) = d0(1:nttl,      :)       !--- Copy titles line(s)
     d1(1+nttl:nr+nttl,icb:ice) = d0(1+ir0:nr+ir0,:)       !--- Copy ith section
     IF(nr1 == nr + nttl) CYCLE
     d1(1+nr+nttl:nr1, icb:ice) =' '                       !--- Fill missing cells with a space
  END DO
END FUNCTION gatherTable
!==============================================================================================================================


!==============================================================================================================================
!--- Convert a set of columns of different natures ("s"trings, "i"ntegers, "r"eals) into a strings table.   Default value
!===  * p:    profile giving the order to pick up columns from "s", "i" and "r" to construct "c(:,:)".        mandatory
!===  * t:    titles, one per variable (2nd index), possibly on several lines (1st index).                    mandatory
!===  * c:    assembled array                                                                                 mandatory
!===  * s:    horizontally stacked string  column vectors of values                                           /
!===  * i:    horizontally stacked integer column vectors of values                                           /
!===  * r:    horizontally stacked real    column vectors of values                                           /
!===  * rFmt: format for real conversion                                                                      *
!===  * sub:  calling subroutine name (for error messages)                                                    /
!=== NOTE: The vectors s, i and r do not have necessarly the same length. Empty elements are filled at the end.
!==============================================================================================================================
LOGICAL FUNCTION convertTable(p, t, c, s, i, r, rFmt, sub) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),                   INTENT(IN)  :: p          !--- DISPLAY MAP: s/i/r
  CHARACTER(LEN=*),                   INTENT(IN)  :: t(:,:)     !--- TITLES (ONE EACH COLUMN)
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: c(:,:)     !--- CONVERTED STRINGS TABLE
  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: s(:,:)     !--- STRINGS
  INTEGER,                  OPTIONAL, INTENT(IN)  :: i(:,:)     !--- INTEGERS
  REAL,                     OPTIONAL, INTENT(IN)  :: r(:,:)     !--- REALS
  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: rFmt       !--- Format for reals
  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: sub        !--- Subroutine name
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
  CHARACTER(LEN=maxlen)  :: rFm, subn
  CHARACTER(LEN=1) :: sp = '|'                             !--- Table cells separator
  INTEGER :: it, is, ii, ir, ic, nmx
  INTEGER :: nt, ns, ni, nr, ncol
  LOGICAL :: ls, li, lr, ll
  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
  subn = '';    IF(PRESENT(sub)) subn = sub
  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
  ns = 0; ni = 0; nr = 0; ncol = 0
  ncol = LEN_TRIM(p)                                       !--- Number of columns of the table
  nt   = SIZE(t,1)

  !--- CHECK ARGUMENTS COHERENCE
  lerr = .NOT.ANY([ls,li,lr])
  CALL msg('missing argument(s) "s", "i" and/or "r"', subn, lerr)
  IF(lerr) RETURN
  lerr = ncol /= SIZE(t,2)
  CALL msg('display map "p" length and titles number mismatch', subn, lerr)
  IF(lerr) RETURN
  IF(ls) THEN; ns = SIZE(s,1)
     lerr = COUNT([(p(ic:ic)=='s', ic=1, ncol)]) /= SIZE(s,2)
     CALL msg('display map "p" and string arguments mismatch: nb(p=="s")/=SIZE(s,2)', subn, lerr)
     IF(lerr) RETURN
  END IF
  IF(li) THEN; ni = SIZE(i,1)
     lerr = COUNT([(p(ic:ic)=='i', ic=1, ncol)]) /= SIZE(i,2)
     CALL msg('display map "p" and integer arguments mismatch: nb(p=="i")/=SIZE(i,2)', subn, lerr)
     IF(lerr) RETURN
  END IF
  IF(lr) THEN; nr = SIZE(r,1)
     lerr = COUNT([(p(ic:ic)=='r', ic=1, ncol)]) /= SIZE(r,2)
     CALL msg('display map "p" and real arguments mismatch: nb(p=="r")/=SIZE(r,2)', subn, lerr)
     IF(lerr) RETURN
  END IF
!  lerr = (ls.AND.li .AND. ns /= ni) .OR. (li.AND.lr .AND. ni /= nr) .OR. (lr.AND.ls .AND. nr /= ns)
!  CALL msg('mismatching rows numbers for at least "s", "i" or "r"', subn, lerr)
!  IF(lerr) RETURN
  nmx = MAX(ns, ni, nr) + nt

  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
  ALLOCATE(c(nmx,ncol))
  is =  1; ii = 1; ir = 1
  DO ic = 1, ncol
    c(1:nt,ic) = t(1:nt,ic)                                          !--- Add titles line(s)
    SELECT CASE(p(ic:ic))
      CASE('s'); c(1+nt:nmx,ic) =         s(:,is)     ; is = is + 1  !--- Add string  elements
      CASE('i'); c(1+nt:nmx,ic) = num2str(i(:,ii)    ); ii = ii + 1  !--- Add integer elements
      CASE('r'); c(1+nt:nmx,ic) = num2str(r(:,ir),rFm); ir = ir + 1  !--- Add real    elements
    END SELECT
  END DO
  CALL cleanZeros(c)                                                 !--- Remove useless zeros in converted numbers

END FUNCTION convertTable
!==============================================================================================================================


!==============================================================================================================================
!--- Build a table from the string array "d(:,:)" as a vector of assembled lines (to be printed as messages).
!===  * each column has the minimum width "n(j)" needed to display the elements "d(:,j)" with at least "nm" spaces each side.
!===  * the structure of a cell is:  <n1 spaces><TRIM(d(i,j))><n2 spaces>| (pay attention to the end separator "|")
!===  * n1 and n2 depend on the justification (three methods available) and give a total width of "n(j)", as expected.
!===  * each cell ends with the separator "|", except the last one
!===  * nTitle/=0 means that the first "nTitle" lines will be separated from the rest of the table with an underline.
!==============================================================================================================================
FUNCTION buildTable(d, nm, nTitle) RESULT(m)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN) :: d(:,:)                  !--- Input array
  INTEGER,           INTENT(IN) :: nm                      !--- Number of spaces before and after values
  INTEGER, OPTIONAL, INTENT(IN) :: nTitle                  !--- Number of rows for titles
  CHARACTER(LEN=10*maxlen), ALLOCATABLE :: m(:)            !--- Lines to issue as messages to display the table
  CHARACTER(LEN=1) :: sp = '|'                             !--- Separator
  INTEGER :: ir, ic, nr, nc, i, j, n(SIZE(d,2)), nttl, id, p
  INTEGER, ALLOCATABLE :: col_len(:), trimmed_len(:)
  nr = SIZE(d, DIM=1); nc = SIZE(d, DIM=2)                 !--- Dimensions of the table
  ALLOCATE(col_len(nc))
  ALLOCATE(trimmed_len(nr))
  nttl = 0; IF(PRESENT(nTitle))  nttl = nTitle
  DO j = 1, nc
     DO i = 1, nr
        trimmed_len(i) = LEN_TRIM(d(i, j))
     END DO
     col_len(j) = MAXVAL(trimmed_len) + 2 * nm
  END DO
  n = col_len
  ALLOCATE(m(nr+1))                                        !--- Allocate the vector (+1 for header line)
  i = 1
  DO ir = 1, nr
     IF(ir <= nttl) CALL centerJustified(d(ir,:), n, i, m(i))
     IF(ir == nttl) CALL      headerLine(         n, i, m(i))
     IF(ir >  nttl) CALL   leftJustified(d(ir,:), n, i, m(i))
  END DO

CONTAINS

SUBROUTINE leftJustified(d, n, i, r)
  CHARACTER(LEN=*), INTENT(IN)    :: d(:)
  INTEGER,          INTENT(IN)    :: n(:)
  CHARACTER(LEN=*), INTENT(INOUT) :: r
  INTEGER,          INTENT(INOUT) :: i
  r = ''
  DO id = 1, nc; r = TRIM(r)//REPEAT(' ',nm)//TRIM(d(id))//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//sp; END DO
  r = r(1:LEN_TRIM(r)-1); i = i+1                          !--- Final separator removed
END SUBROUTINE leftJustified

SUBROUTINE centerJustified(d, n, i, r)
  CHARACTER(LEN=*), INTENT(IN)    :: d(:)
  INTEGER,          INTENT(IN)    :: n(:)
  INTEGER,          INTENT(INOUT) :: i
  CHARACTER(LEN=*), INTENT(INOUT) :: r
  INTEGER :: p
  r = ''; DO id = 1, nc; p=n(id)-LEN_TRIM(d(id)); r = TRIM(r)//REPEAT(' ', p - p/2)//TRIM(d(id))//REPEAT(' ', p/2)//sp; END DO
  r = r(1:LEN_TRIM(r)-1); i = i+1                          !--- Final separator removed
END SUBROUTINE centerJustified

SUBROUTINE rightJustified(d, n, i, r)
  CHARACTER(LEN=*), INTENT(IN)    :: d(:)
  INTEGER,          INTENT(IN)    :: n(:)
  INTEGER,          INTENT(INOUT) :: i
  CHARACTER(LEN=*), INTENT(INOUT) :: r
  r = ''; DO id = 1, nc; r = TRIM(r)//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//TRIM(d(id))//REPEAT(' ',nm)//sp; END DO
  r = r(1:LEN_TRIM(r)-1); i = i+1                          !--- Final separator removed
END SUBROUTINE rightJustified

SUBROUTINE headerLine(n, i, r)
  INTEGER,          INTENT(IN)    :: n(:)
  INTEGER,          INTENT(INOUT) :: i
  CHARACTER(LEN=*), INTENT(INOUT) :: r
  r = ''; DO id= 1 , nc; r = TRIM(r)//REPEAT('-',n(id))//'+'; END DO
  r = r(1:LEN_TRIM(r)-1); i = i+1                          !--- Final '+' removed
END SUBROUTINE headerLine

END FUNCTION buildTable
!==============================================================================================================================


!==============================================================================================================================
LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
  IMPLICIT NONE
  INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)        !--- INTEGERS
  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)        !--- REALS
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen)  :: rFm, el
  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
  CHARACTER(LEN=:),      ALLOCATABLE :: sp, row
  INTEGER :: is, ii, ir, nrow, ic
  INTEGER :: ns, ni, nr, ncol, np
  INTEGER, ALLOCATABLE :: n(:)
  LOGICAL :: ls, li, lr, la
  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
  lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN          !--- Nothing to do
  la = .FALSE.; IF(PRESENT(llast)) la = llast

  !--- CHECK ARGUMENTS COHERENCE
  ns = 0; ni = 0; nr = 0; np = LEN_TRIM(p); ncol = 0
  IF(ls) THEN; ns = SIZE(s, DIM=1); ncol = ncol + SIZE(s, DIM=2)
    lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, DIM=2)
  END IF
  IF(li) THEN; ni = SIZE(i, DIM=1); ncol = ncol + SIZE(i, DIM=2)
    lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, DIM=2)
  END IF
  IF(lr) THEN; nr = SIZE(r, DIM=1); ncol = ncol + SIZE(r, DIM=2)
    lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
  END IF
  CALL msg('display map "p" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
  lerr = ncol /= SIZE(titles); CALL msg('"titles" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
  lerr = ls.AND.li.AND.ns/=ni; CALL msg('string and integer arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
  lerr = ls.AND.lr.AND.ns/=nr; CALL msg(   'string and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
  lerr = li.AND.lr.AND.ni/=nr; CALL msg(  'integer and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN

  !--- Allocate the assembled quantities array
  nrow = MAX(ns,ni,nr)+1
  ALLOCATE(d(nrow,ncol), n(ncol))

  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
  is =  1; ii = 1; ir = 1
  DO ic = 1, ncol
    d(1,ic) = TRIM(titles(ic))
    SELECT CASE(p(ic:ic))
      CASE('s'); d(2:nrow,ic) =         s(:,is)     ; is = is + 1
      CASE('i'); d(2:nrow,ic) = num2str(i(:,ii)    ); ii = ii + 1
      CASE('r'); d(2:nrow,ic) = num2str(r(:,ir),rFm); ir = ir + 1
    END SELECT
  END DO
  CALL cleanZeros(d)
  DO ic = 1, ncol
    n(ic) = 0; DO ir=1, nrow; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
    IF(needQuotes(d(2,ic)) .AND. ic/=1) n(ic) = n(ic) + 2 !--- For quotes, using second line only
  END DO

  !--- Display the strings array as a table
  DO ir = 1, nrow
    row = ''; sp = '   '; IF(TRIM(d(ir,1)) /= '') sp = ' = '
    DO ic = 1, ncol
      el = d(ir,ic); IF(ic /= 1) el = addQuotes_1(el)
      row = row//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el))//sp
      sp = '   '; IF(ic /= ncol-1) CYCLE
      IF(TRIM(d(MIN(ir+1,nrow),1)) /= '' .AND. (ir /= nrow .OR. .NOT.la)) sp = ' , '
    END DO
    WRITE(unt,'(a)')TRIM(row)
  END DO

  !--- End of section
  IF(la) THEN
    WRITE(unt,'(a)')'/'
    WRITE(unt,'(a)')
  END IF

END FUNCTION dispNameList
!==============================================================================================================================


!==============================================================================================================================
!=== DISPLAY OUTLIERS IN TABLES ===============================================================================================
!==============================================================================================================================
!=== lerr = dispOutliers_1(ll(:), a(:[:]), n(:), err_msg, nam(:), sub, nRowmax, nColMax, unit)
!===  * ll    linearized mask of outliers
!===  * a     linearized fields:
!===    a(:)  all the fields are linearized (all contane
!=== Behaviour depends on ll(:), n(:) and nam(:). We note hereafter nv = SIZE(nam).
!===
!=== 1) if SIZE(ll) == PRODUCT(n) and nv==1 or "nam" is unspecified:           outliers of a single variable are displayed
!===     i[,j[,k]] |       nam       |
!===     ----------+-----------------+
!===     *[,*[,*]] | val(i[,j[,k]])  |
!===        ...    |      ...        |
!===
!===
!=== 2) if SIZE(ll) == PRODUCT(n) and nv>1:                "nv" tables of outliers are displayed, each having its own mask
!===     i[,j] |    var(1)
!===     ------+--------------
!===     *[,*] | val(i[,j],1)
!===      ...  |     ...
!===
!===          ...
!===
!===     i[,j] |    var(nv)
!===     ------+---------------
!===     *[,*] | val(i[,j],nv)
!===      ...  |     ...
!===
!===
!=== 3) if SIZE(ll) = PRODUCT(n(1:SIZE(n)-1):              outliers of "nv" variables are displayed, all with mask "ll(:)"
!===     i[,j] |    var(1)    |    var(2)     |   ...   |    var(nv)       
!===     ------+--------------+---------------+-- ... --+---------------
!===     *[,*] | val(i[,j],1) | val(i[,j],2)  |   ...   | val(i[,j],nv)
!===      ...  |     ...      |     ...       |   ...   |     ...
!===
!===  NOTES:
!===  * in cases 2 and 3, SIZE(nam) MUST be equal to n(SIZE(n)).
!===  * for the sake of readability, narrow tables (compared to the max. width "nColMax") are horizontally stacked.
!===  Here is the result in the case 1:
!===    i[,j[,k]] |       nam       | i[,j[,k]] |       nam       |   ...   | i[,j[,k]] |       nam       
!===    ----------+-----------------+-----------+-----------------+-- ... --+-----------+-----------------
!===    *[,*[,*]] | val(i[,j[,k]])  | *[,*[,*]] | val(i[,j[,k]])  |   ...   | *[,*[,*]] | val(i[,j[,k]])
!===       ...    |      ...        |    ...    |      ...        |   ...   |    ...    |      ...
!===  * conversly, in case 3, too wide tables are displayed as several sub-tables.
!===  * too long tables are truncated to nRowMax lines (excluding titles lines).
!==============================================================================================================================
LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, unit) RESULT(lerr)
  IMPLICIT NONE
! Display outliers list in tables
! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), sub    !--- Error message, variables and calling subroutine names
  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen),      ALLOCATABLE :: t(:), vnm(:), c(:,:)
  LOGICAL,                    ALLOCATABLE :: m(:), ld(:)
  INTEGER,                    ALLOCATABLE :: ki(:), kj(:)
  INTEGER                                 :: rk, ib, ie, itr, nm, unt, nRmx, nCmx, iv, nv, np
  CHARACTER(LEN=maxlen)                   :: mes, subn, fm='(f12.9)', p
  lerr = .FALSE.

  IF(.NOT.ANY(ll)) RETURN                                            !--- No outliers -> finished

  mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg         !--- Error message
  vnm = ['a'];            IF(PRESENT(nam))     vnm = nam             !--- Variables names
  subn= 'dispOutliers';   IF(PRESENT(sub))     subn= sub             !--- Calling subroutine name
  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!--- Maximum number of lines to print
  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!--- Maximum number of characters each line
  unt = lunout;           IF(PRESENT(unit))    unt = unit            !--- Unit to print messages

  rk = SIZE(n)                                                       !--- Rank of "a" before linearization
  nv = SIZE(vnm)                                                     !--- Number of variables
  np = PRODUCT(n(1:rk-1))                                            !--- Number of points per var (in the multiple vars case)
  lerr = rk>3;                  CALL msg('can display field with rank <=3 only !', subn, lerr, unt); IF(lerr) RETURN
  lerr = n(rk) == 1;            CALL msg('degenerated last dim: n(SIZE(n)) = 1 !', subn, lerr, unt); IF(lerr) RETURN
  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', subn, lerr, unt); IF(lerr) RETURN
  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', subn, lerr, unt); IF(lerr) RETURN
  lerr = ALL([PRODUCT(n),np] /= SIZE(ll))
  CALL msg('ll" length must be either PROD(n) or PROD(n(1:rk-1))', subn, lerr, unt); IF(lerr) RETURN

  !============================================================================================================================
  IF(SIZE(ll) == PRODUCT(n)) THEN                                    !=== ll(:) IS A MASK FOR THE WHOLE a(:) VECTOR ===========
  !============================================================================================================================
     p = 's'//REPEAT('r',nv)                                         !--- Display map: one string, "nv" reals
     IF(nv == 1) THEN                                                !=== SINGLE VARIABLE
        CALL buildTitle(n, vnm, t)                                   !--- Build titles list "t" for a single variable
        CALL buildCoord(n, ll, c)                                    !--- Masked ("ll") coordinates vector "c"
        lerr = dispTable(p, t, s=c, r=cat(PACK(a,ll)), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, unit=unt, sub=subn)
     ELSE                                                            !=== MULTIPLE VARIABLES
        DO iv = 1, nv
           CALL buildTitle(n, vnm(iv:iv), t)                         !--- Titles list "t" for the "iv"th variables
           CALL buildCoord(n(1:rk-1), ll, c)                         !--- Masked ("ll") coordinates vector "c"
           ib = 1+(iv-1)*np; ie = ib+np
           lerr = dispTable(p, t, s=c, r=cat(PACK(a(ib:ie),ll(ib:ie))), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, &
                                                                                                    unit=unt, sub=subn)
           CALL msg("can't display outliers table", subn, lerr, unt); IF(lerr) RETURN
        END DO
     END IF
  !============================================================================================================================
  ELSE                                                              !=== ll(:) IS A MASK FOR EACH TRACER STACKED IN a(:) VECTOR
  !============================================================================================================================
     CALL buildTitle(n, vnm, t)                                     !--- Build titles list "t" for all the variable
     CALL duplicate(ll, nv, ld)                                     !--- "ll" concatenated "nv" times
     CALL buildCoord(n(1:rk-1), ll, c)                              !--- Masked ("ll") coordinates vector "c"
     lerr = dispTable(p, t, s=c, r=RESHAPE(PACK(a,ld),[np,nv]), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1,unit=unt,sub=subn)
  !============================================================================================================================
  END IF
  !============================================================================================================================
  CALL msg("can't display outliers table", subn, lerr, unt)

CONTAINS

SUBROUTINE buildTitle(n, vname, title)                               !=== BUILD TITLES: [COORD. NAME, THE VARIABLE(S) NAME(S)]
  INTEGER,                            INTENT(IN)  ::     n(:)
  CHARACTER(LEN=maxlen),              INTENT(IN)  :: vname(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: title(:)
  INTEGER :: rk
  rk = SIZE(n)
  ALLOCATE(title(1+SIZE(vname)))
  title(2:SIZE(vname)+1) = vname
  title(1) = 'i'
  IF(rk >= 2) title(1) = TRIM(title(1))//', j'
  IF(rk >= 3) title(1) = TRIM(title(1))//', k'
END SUBROUTINE buildTitle

SUBROUTINE buildCoord(n, mask, coord)                                !=== BUILD MASKED COORDINATES OK FOR "s" ARG OF dispTable
  INTEGER,                            INTENT(IN)  ::     n(:)
  LOGICAL,                            INTENT(IN)  ::  mask(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: coord(:,:)
  CHARACTER(LEN=maxlen) :: sj, sk
  INTEGER :: i, j, k, m(3), rk, ic
  rk = SIZE(n)
  m(:) = 1;  m(1:rk) = n(:)
  ALLOCATE(coord(1,COUNT(mask)))
  ic = 0
  DO k = 1, m(3); sk = ', '//num2str(k)
     DO j = 1, m(2); sj = ', '//num2str(j)
        DO i = 1, m(1)
           IF(.NOT.mask(i+m(1)*(j+m(2)*k))) CYCLE
           ic = ic+1
           coord(ic,1) = num2str(i)
           IF(rk >= 2) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sj)
           IF(rk >= 3) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sk)
        END DO
     END DO
  END DO
END SUBROUTINE buildCoord

END FUNCTION dispOutliers_1
!==============================================================================================================================
LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, unit) RESULT(lerr)
  IMPLICIT NONE
! Display outliers list in tables
! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
  REAL,                       INTENT(IN)  ::  a(:,:)                 !--- Linearized array of values
  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), sub    !--- Error message, variables and calling subroutine names
  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
!------------------------------------------------------------------------------------------------------------------------------
  lerr = dispOutliers_1(ll, PACK(a, MASK=.TRUE.), n, err_msg, nam, sub, nRowmax, nColMax, unit)
END FUNCTION dispOutliers_2
!==============================================================================================================================


!==============================================================================================================================
!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
!==============================================================================================================================
LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),      INTENT(IN)  :: str
  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen)              :: v
  CHARACTER(LEN=1024)                :: s, vv
  CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
  INTEGER,             ALLOCATABLE :: ip(:)
  INTEGER :: nl, nn, i, j, im, ix
  LOGICAL :: ll
  s = str

  !--- Check wether the parenthesis are correctly formed
  ll = strCount(s,'(',nl)
  ll = strCount(s,')',nn)
  lerr = nl /= nn
  CALL msg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr); IF(lerr) RETURN
  nl = 2*nl-1

  !--- Build vectors ; vl: parenthesis-separated elements ; ip: parenthesis types (1: opening, 2: closing)
  ALLOCATE(ip(nl-1),vl(nl))
  j = 1; im = 1
  DO i = 1, LEN_TRIM(str)
    ix = INDEX('()', str(i:i))
    IF(ix == 0) CYCLE
    ip(j) = ix
    vl(j) = str(im:i-1)
    j = j + 1; im = i + 1
  END DO
  vl(j) = str(im:LEN_TRIM(str))

  !--- Search for each opening/closing parenthesis pair
  DO WHILE(nl > 1)
    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
    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
    v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
    vv = v//REPEAT(' ',768)
    IF(i == 1) THEN;         ip =  ip(3:nl-1);                vl = [            vv, vl(4  :nl)]
    ELSE IF(i == nl-1) THEN; ip =  ip(1:nl-2);                vl = [vl(1:nl-3), vv            ]
    ELSE;                    ip = [ip(1: i-1), ip(i+2:nl-1)]; vl = [vl(1: i-1), vv, vl(i+3:nl)]; END IF
    nl = SIZE(vl)
  END DO
  lerr = reduceExpr_basic(vl(1), val)
END FUNCTION reduceExpr_1


!==============================================================================================================================
!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
!==============================================================================================================================
LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),      INTENT(IN)  :: str
  CHARACTER(LEN=*),      INTENT(OUT) :: val
  REAL(KIND=REAL64),     ALLOCATABLE :: vl(:)
  INTEGER,               ALLOCATABLE :: id(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=1024) :: s
  REAL(KIND=REAL64) :: v, vm, vp
  INTEGER      :: i, ni, io
  lerr = .FALSE.
  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
  s = str
  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
  IF(lerr) RETURN                                                              !--- Problem with the parsing
  vl = str2dble(ky)                                                            !--- Conversion to doubles
  lerr = ANY(vl >= HUGE(1._REAL64))
  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
  IF(lerr) RETURN                                                              !--- Non-numerical values found
  DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
    DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
      ni = SIZE(id)
      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
        CASE('^'); v = vm**vp
        CASE('/'); v = vm/vp
        CASE('*'); v = vm*vp
        CASE('+'); v = vm+vp
        CASE('-'); v = vm-vp
      END SELECT
      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
      IF(i == ni) THEN; id =  id(1:ni-1);     ELSE; id = [id(1:i-1),    id(i+1:ni  )]; END IF
    END DO
  END DO
  val = num2str(vl(1))

END FUNCTION reduceExpr_basic
!==============================================================================================================================

!==============================================================================================================================
FUNCTION reduceExpr_m(str, val) RESULT(lerr)
  IMPLICIT NONE
  LOGICAL,               ALLOCATABLE              :: lerr(:)
  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: i
  ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
  lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
END FUNCTION reduceExpr_m
!==============================================================================================================================


!==============================================================================================================================
!=== Check whether a string is a number or not ================================================================================
!==============================================================================================================================
ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  REAL    :: x
  INTEGER :: e
  CHARACTER(LEN=12) :: fmt
  IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
  WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
  READ(str,fmt,IOSTAT=e) x
  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
END FUNCTION is_numeric
!==============================================================================================================================


!==============================================================================================================================
!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
!==============================================================================================================================
ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: ierr
  LOGICAL :: lout
  READ(str,*,IOSTAT=ierr) lout
  out = -HUGE(1)
  IF(ierr /= 0) THEN
    IF(ANY(['.false.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
    IF(ANY(['.true. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
  ELSE
    out = 0; IF(lout) out = 1
  END IF
END FUNCTION str2bool
!==============================================================================================================================
ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: ierr
  READ(str,*,IOSTAT=ierr) out
  IF(ierr/=0) out = -HUGE(1)
END FUNCTION str2int
!==============================================================================================================================
ELEMENTAL REAL(KIND=REAL32) FUNCTION str2real(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: ierr
  READ(str,*,IOSTAT=ierr) out
  IF(ierr/=0) out = -HUGE(1._REAL32)
END FUNCTION str2real
!==============================================================================================================================
ELEMENTAL REAL(KIND=REAL64) FUNCTION str2dble(str) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER :: ierr
  READ(str,*,IOSTAT=ierr) out
  IF(ierr/=0) out = -HUGE(1._REAL64)
END FUNCTION str2dble
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
  IMPLICIT NONE
  LOGICAL, INTENT(IN) :: b
  WRITE(out,*)b
  out = ADJUSTL(out)
END FUNCTION bool2str
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: i
  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
!------------------------------------------------------------------------------------------------------------------------------
  WRITE(out,*)i
  out = ADJUSTL(out)
  IF(.NOT.PRESENT(nDigits)) RETURN
  IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
END FUNCTION int2str
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL32),          INTENT(IN) :: r
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
!------------------------------------------------------------------------------------------------------------------------------
  IF(     PRESENT(fmt)) WRITE(out,fmt)r
  IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
  out = ADJUSTL(out)
END FUNCTION real2str
!==============================================================================================================================
ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
  IMPLICIT NONE
  REAL(KIND=REAL64),          INTENT(IN) :: d
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
!------------------------------------------------------------------------------------------------------------------------------
  IF(     PRESENT(fmt)) WRITE(out,fmt)d
  IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
  out = ADJUSTL(out)
END FUNCTION dble2str
!==============================================================================================================================
ELEMENTAL SUBROUTINE cleanZeros(s)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(INOUT) :: s
  INTEGER :: ls, ix, i
  IF(is_numeric(s)) THEN
    ls = LEN_TRIM(s)
    ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
    IF(ix == 0) THEN
      DO ix = ls,1,-1; IF(s(ix:ix) /= '0') EXIT; END DO; s=s(1:ix+1)
    ELSE IF(INDEX(s,'.')/=0) THEN
      i = ix-1; DO WHILE(s(i:i) == '0'); i = i-1; END DO; s=s(1:i)//s(ix:ls)
    END IF
  END IF
END SUBROUTINE cleanZeros
!==============================================================================================================================


!==============================================================================================================================
FUNCTION addQuotes_1(s) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN)  :: s
  CHARACTER(LEN=:), ALLOCATABLE :: out
  IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
END FUNCTION addQuotes_1
!==============================================================================================================================
FUNCTION addQuotes_m(s) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN)  :: s(:)
  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
!------------------------------------------------------------------------------------------------------------------------------
  INTEGER :: k, n
  n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
  ALLOCATE(CHARACTER(LEN=n) :: out(SIZE(s)))
  DO k=1,SIZE(s)
    IF(needQuotes(s(k))) THEN; out(k) = "'"//TRIM(s(k))//"'"; ELSE; out(k) = s(k); END IF
  END DO
END FUNCTION addQuotes_m
!==============================================================================================================================
ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(IN) :: s
  CHARACTER(LEN=1) :: b, e
!------------------------------------------------------------------------------------------------------------------------------
  out = .TRUE.; IF(TRIM(s) == '') RETURN
  b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
  out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
END FUNCTION needQuotes
!==============================================================================================================================


!==============================================================================================================================
!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
!==============================================================================================================================
LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
  IMPLICIT NONE
! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
  CHARACTER(LEN=*),   INTENT(IN)  :: str(:)
  LOGICAL,            INTENT(IN)  :: lerr(:)
  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
!------------------------------------------------------------------------------------------------------------------------------
  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
  INTEGER :: i, nmx
  nmx = 256; IF(PRESENT(nmax)) nmx=nmax
  out = ANY(lerr); IF(.NOT.out) RETURN
  CALL msg(TRIM(message)//': the following '//TRIM(items)//' are '//TRIM(reason)//':')
  s = strStackm(PACK(str, MASK=lerr), ', ',nmx)
  DO i=1,SIZE(s,DIM=1); CALL msg(s(i)); END DO
END FUNCTION checkList
!==============================================================================================================================


!==============================================================================================================================
!=== Remove comment in line "str", ie all the characters from the first "#" sign found in "str". ==============================
!==============================================================================================================================
SUBROUTINE removeComment(str)
  IMPLICIT NONE
  CHARACTER(LEN=*), INTENT(INOUT) :: str
  INTEGER :: ix
  ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)
END SUBROUTINE removeComment
!==============================================================================================================================


END MODULE strings_mod
strings_mod.f90 Source File

Contents

Modules

Source Code

Files dependent on this one

Contents

Modules

Source Code

Source Code
