Context Navigation

strings_mod.f90 @ 5754

Last change on this file since 5754 was 5754, checked in by dcugnet, 9 days ago
Make the ioipsl_getin_p routine more flexible: optional default value and optional flag to print or not the effective value of the key => get rid of the get_in routine
File size: 113.2 KB

Rev	Line
[4046]	1	MODULE strings_mod
	2
[5748]	3	USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: REAL64, REAL32
	4
[4046]	5	IMPLICIT NONE
	6
	7	PRIVATE
[5754]	8	PUBLIC :: maxlen, init_printout, msg, lunout, prt_level, maxTableWidth
[4068]	9	PUBLIC :: strLower, strHead, strStack, strCount, strReduce, strClean, strIdx
[5747]	10	PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, duplicate, cat
[4046]	11	PUBLIC :: dispTable, dispOutliers, dispNameList
[5748]	12	PUBLIC :: is_numeric, num2str, str2bool, str2int, str2real, str2dble
	13	PUBLIC :: reduceExpr, addQuotes, checkList, removeComment
[4046]	14
[5748]	15	INTERFACE num2str; MODULE PROCEDURE bool2str, int2str, real2str, dble2str; END INTERFACE num2str
[4046]	16	INTERFACE msg; MODULE PROCEDURE msg_1, msg_m; END INTERFACE msg
	17	INTERFACE strHead; MODULE PROCEDURE strHead_1, strHead_m; END INTERFACE strHead
	18	INTERFACE strTail; MODULE PROCEDURE strTail_1, strTail_m; END INTERFACE strTail
	19	INTERFACE strClean; MODULE PROCEDURE strClean_1, strClean_m; END INTERFACE strClean
	20	INTERFACE strReduce; MODULE PROCEDURE strReduce_1, strReduce_2; END INTERFACE strReduce
	21	INTERFACE strIdx; MODULE PROCEDURE strIdx_1, strIdx_m; END INTERFACE strIdx
	22	INTERFACE strCount; MODULE PROCEDURE strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
	23	INTERFACE strReplace; MODULE PROCEDURE strReplace_1, strReplace_m; END INTERFACE strReplace
[5751]	24	INTERFACE cat; MODULE PROCEDURE horzcat_s00, horzcat_i00, horzcat_r00, horzcat_d00, horzcat_l00, &
	25	horzcat_s10, horzcat_i10, horzcat_r10, horzcat_d10, horzcat_l10, &
	26	horzcat_s11, horzcat_i11, horzcat_r11, horzcat_d11, horzcat_l11, &
	27	horzcat_s21, horzcat_i21, horzcat_r21, horzcat_d21, horzcat_l21, &
	28	horzcat_s22, horzcat_i22, horzcat_r22, horzcat_d22, horzcat_l22; END INTERFACE cat
[5748]	29	INTERFACE strFind; MODULE PROCEDURE strFind_1, strFind_m; END INTERFACE strFind
[5751]	30	INTERFACE find; MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
[5747]	31	INTERFACE duplicate; MODULE PROCEDURE dupl_s, dupl_i, dupl_r, dupl_l; END INTERFACE duplicate
[5751]	32	INTERFACE dispTable; MODULE PROCEDURE dispTable_1, dispTable_2; END INTERFACE dispTable
[4046]	33	INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
	34	INTERFACE reduceExpr; MODULE PROCEDURE reduceExpr_1, reduceExpr_m; END INTERFACE reduceExpr
	35	INTERFACE addQuotes; MODULE PROCEDURE addQuotes_1, addQuotes_m; END INTERFACE addQuotes
	36
	37	INTEGER, PARAMETER :: maxlen = 256 !--- Standard maximum length for strings
	38	INTEGER, SAVE :: lunout = 6 !--- Printing unit (default: 6, ie. on screen)
	39	INTEGER, SAVE :: prt_level = 1 !--- Printing level (default: 1, ie. print all)
[5751]	40	INTEGER, SAVE :: maxTableWidth = 192 !--- Default max. number of characters per lines in dispTable
[4046]	41
	42	CONTAINS
	43
	44	!==============================================================================================================================
	45	SUBROUTINE init_printout(lunout_, prt_level_)
[5001]	46	IMPLICIT NONE
[4046]	47	INTEGER, INTENT(IN) :: lunout_, prt_level_
[4363]	48	lunout = lunout_
	49	prt_level = prt_level_
[4046]	50	END SUBROUTINE init_printout
	51	!==============================================================================================================================
	52
	53
	54	!==============================================================================================================================
	55	!=== Display one or several messages, one each line, starting with the current routine name "modname".
	56	!==============================================================================================================================
	57	SUBROUTINE msg_1(str, modname, ll, unit)
[5001]	58	IMPLICIT NONE
[4046]	59	!--- Display a simple message "str". Optional parameters:
	60	! * "modname": module name, displayed in front of the message (with ": " separator) if present.
	61	! * "ll": message trigger ; message is displayed only if ll==.TRUE.
	62	! * "unit": write unit (by default: "lunout")
	63	CHARACTER(LEN=*), INTENT(IN) :: str
	64	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	65	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	66	INTEGER, OPTIONAL, INTENT(IN) :: unit
[4349]	67	!------------------------------------------------------------------------------------------------------------------------------
[4120]	68	CHARACTER(LEN=maxlen) :: subn
[4046]	69	INTEGER :: unt
[4120]	70	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	71	IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
[4046]	72	unt = lunout; IF(PRESENT(unit)) unt = unit
[4120]	73	IF(subn == '') WRITE(unt,'(a)') str !--- Simple message
	74	IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str !--- Routine name provided
[4046]	75	END SUBROUTINE msg_1
	76	!==============================================================================================================================
	77	SUBROUTINE msg_m(str, modname, ll, unit, nmax)
[5001]	78	IMPLICIT NONE
[4046]	79	!--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
	80	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	81	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	82	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	83	INTEGER, OPTIONAL, INTENT(IN) :: unit
	84	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	85	!------------------------------------------------------------------------------------------------------------------------------
[4046]	86	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
[4120]	87	CHARACTER(LEN=maxlen) :: subn
[4046]	88	INTEGER :: unt, nmx, k
[4063]	89	LOGICAL :: l
[4120]	90	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	91	l = .TRUE.; IF(PRESENT(ll)) l = ll
	92	unt = lunout; IF(PRESENT(unit)) unt = unit
	93	nmx = 128; IF(PRESENT(nmax)) nmx = nmax
[4046]	94	s = strStackm(str, ', ', nmx)
[4120]	95	DO k=1,SIZE(s); CALL msg_1(s(k), subn, l, unt); END DO
[4046]	96	END SUBROUTINE msg_m
	97	!==============================================================================================================================
	98
	99
	100	!==============================================================================================================================
	101	!=== Lower/upper case conversion function. ====================================================================================
	102	!==============================================================================================================================
[5745]	103	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
[5001]	104	IMPLICIT NONE
[4046]	105	CHARACTER(LEN=*), INTENT(IN) :: str
	106	INTEGER :: k
	107	out = str
	108	DO k=1,LEN_TRIM(str)
[4120]	109	IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
[4046]	110	END DO
	111	END FUNCTION strLower
	112	!==============================================================================================================================
[5745]	113	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
[5001]	114	IMPLICIT NONE
[4046]	115	CHARACTER(LEN=*), INTENT(IN) :: str
	116	INTEGER :: k
	117	out = str
	118	DO k=1,LEN_TRIM(str)
[4120]	119	IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
[4046]	120	END DO
	121	END FUNCTION strUpper
	122	!==============================================================================================================================
	123
	124
	125	!==============================================================================================================================
[4403]	126	!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str" ================
[4046]	127	!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================
	128	!=== * strHead(..,.FALSE.) = 'a' ${str%%$sep*} ================
	129	!=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================
	130	!==============================================================================================================================
[5745]	131	CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
[5001]	132	IMPLICIT NONE
[4046]	133	CHARACTER(LEN=*), INTENT(IN) :: str
	134	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4403]	135	LOGICAL, OPTIONAL, INTENT(IN) :: lBackward
[4349]	136	!------------------------------------------------------------------------------------------------------------------------------
[4046]	137	IF(PRESENT(sep)) THEN
[4403]	138	IF( PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
	139	IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
[4046]	140	ELSE
[4403]	141	IF( PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
	142	IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
[4046]	143	END IF
	144	IF(out == '') out = str
	145	END FUNCTION strHead_1
	146	!==============================================================================================================================
[4403]	147	FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
[5001]	148	IMPLICIT NONE
[4046]	149	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	150	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	151	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4403]	152	LOGICAL, OPTIONAL, INTENT(IN) :: lBackward
[4349]	153	!------------------------------------------------------------------------------------------------------------------------------
[4046]	154	INTEGER :: k
	155	IF(PRESENT(sep)) THEN
[4403]	156	IF( PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
	157	IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep), k=1, SIZE(str))]
[4046]	158	ELSE
[4403]	159	IF( PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
	160	IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'), k=1, SIZE(str))]
[4046]	161	END IF
	162	END FUNCTION strHead_m
	163	!==============================================================================================================================
[4403]	164	!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str" ================
[4046]	165	!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================
[4403]	166	!=== * strTail(str, '_', .FALSE.) = 'b_c' ${str#*$sep} ================
	167	!=== * strTail(str, '_', .TRUE.) = 'c' ${str##*$sep} ================
[4046]	168	!==============================================================================================================================
[5745]	169	CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
[5001]	170	IMPLICIT NONE
[4046]	171	CHARACTER(LEN=*), INTENT(IN) :: str
	172	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4403]	173	LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard
[4349]	174	!------------------------------------------------------------------------------------------------------------------------------
[4046]	175	IF(PRESENT(sep)) THEN
[4403]	176	IF( PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
	177	IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep) +LEN(sep):LEN_TRIM(str))
[4046]	178	ELSE
[4403]	179	IF( PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
	180	IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/') +1:LEN_TRIM(str))
[4046]	181	END IF
	182	IF(out == '') out = str
	183	END FUNCTION strTail_1
	184	!==============================================================================================================================
[4403]	185	FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
[5001]	186	IMPLICIT NONE
[4046]	187	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	188	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	189	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4403]	190	LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard
[4349]	191	!------------------------------------------------------------------------------------------------------------------------------
[4046]	192	INTEGER :: k
	193	IF(PRESENT(sep)) THEN
[4403]	194	IF( PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
	195	IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep), k=1, SIZE(str))]
[4046]	196	ELSE
[4403]	197	IF( PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
	198	IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'), k=1, SIZE(str))]
[4046]	199	END IF
	200	END FUNCTION strTail_m
	201	!==============================================================================================================================
	202
	203
	204	!==============================================================================================================================
	205	!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
	206	!==============================================================================================================================
[4063]	207	FUNCTION strStack(str, sep, mask) RESULT(out)
[5001]	208	IMPLICIT NONE
[4046]	209	CHARACTER(LEN=:), ALLOCATABLE :: out
	210	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	211	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4063]	212	LOGICAL, OPTIONAL, INTENT(IN) :: mask(:)
[4349]	213	!------------------------------------------------------------------------------------------------------------------------------
[4046]	214	CHARACTER(LEN=:), ALLOCATABLE :: s
[4063]	215	INTEGER :: is, i0
[4046]	216	IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
	217	ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
[4063]	218	IF(PRESENT(mask)) THEN
	219	IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF
	220	i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO
	221	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
	222	ELSE
	223	out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
	224	END IF
[4046]	225	END FUNCTION strStack
	226	!==============================================================================================================================
	227	!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
	228	!==============================================================================================================================
	229	FUNCTION strStackm(str, sep, nmax) RESULT(out)
[5001]	230	IMPLICIT NONE
[4046]	231	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	232	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	233	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	234	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	235	!------------------------------------------------------------------------------------------------------------------------------
[4046]	236	CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
	237	CHARACTER(LEN=maxlen) :: sp
	238	INTEGER :: is, ns, no, mx, n
	239	IF(SIZE(str) == 0) THEN; out = ['']; RETURN; END IF
	240	sp =', '; IF(PRESENT(sep )) sp = sep
	241	ns = 2 ; IF(PRESENT(sep )) ns = LEN(sep)
	242	mx = 256; IF(PRESENT(nmax)) mx = nmax
	243	no = 1; out = ['']
	244	DO is = 1, SIZE(str)
	245	n = LEN_TRIM(str(is)); IF(out(no)/='') n = n+ns+LEN_TRIM(out(no)) !--- Line length after "str(is)" inclusion
	246	IF(out(no) == '') THEN
	247	out(no) = str(is) !--- Empty new line: set to "str(is)"
	248	ELSE IF(n <= mx) THEN
	249	out(no) = TRIM(out(no))//sp(1:ns)//TRIM(str(is)) !--- Append "str(is)" to the current line
	250	ELSE
	251	ALLOCATE(t(no+1)); t(1:no) = out; no=no+1; t(no) = str(is) !--- Full line: "str(si)" put in next line
	252	CALL MOVE_ALLOC(FROM=t, TO=out)
	253	END IF
	254	END DO
	255	END FUNCTION strStackm
	256	!==============================================================================================================================
	257
	258
	259	!==============================================================================================================================
	260	!=== String cleaning: replace tabulation by spaces, remove NULL characters and comments. ======================================
	261	!==============================================================================================================================
	262	SUBROUTINE strClean_1(str)
[5001]	263	IMPLICIT NONE
[4046]	264	CHARACTER(LEN=*), INTENT(INOUT) :: str
	265	INTEGER :: k, n, m
	266	n = LEN(str)
	267	DO k = n, 1, -1
	268	m = IACHAR(str(k:k))
	269	IF(m==9) str(k:k) = ' ' !--- Replace the tabulations with spaces
	270	IF(m==0) str(k:n) = str(k+1:n)//' ' !--- Remove the NULL characters
	271	END DO
	272	m = INDEX(str,'!')-1; IF(m==-1) m = LEN_TRIM(str) !--- Remove end of line comment
	273	str = ADJUSTL(str(1:m))
	274	END SUBROUTINE strClean_1
	275	!==============================================================================================================================
	276	SUBROUTINE strClean_m(str)
[5001]	277	IMPLICIT NONE
[4046]	278	CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
	279	INTEGER :: k
	280	DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
	281	END SUBROUTINE strClean_m
	282	!==============================================================================================================================
	283
	284
	285	!==============================================================================================================================
	286	!=== strReduce_1(str1) : Remove duplicated elements of str1. ===========================================================
	287	!=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
	288	!==============================================================================================================================
[4067]	289	SUBROUTINE strReduce_1(str, nb)
[5001]	290	IMPLICIT NONE
[4067]	291	CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
[4046]	292	INTEGER, OPTIONAL, INTENT(OUT) :: nb
[4349]	293	!------------------------------------------------------------------------------------------------------------------------------
[4046]	294	CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
[4068]	295	INTEGER :: k, n, n1
	296	IF(PRESENT(nb)) nb = 0
	297	CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
	298	n1 = SIZE(s1, DIM=1) !--- Total nb. of elements in "s1"
	299	n = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] ) !--- Nb of unique elements in "s1"
	300	ALLOCATE(str(n))
	301	IF(n==0) RETURN
	302	str(1) = s1(1)
[4069]	303	n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str(n)=s1(k); END DO
[4068]	304	IF(PRESENT(nb)) nb=n
[4046]	305	END SUBROUTINE strReduce_1
	306	!==============================================================================================================================
	307	SUBROUTINE strReduce_2(str1, str2)
[5001]	308	IMPLICIT NONE
[4046]	309	CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str1(:)
	310	CHARACTER(LEN=*), INTENT(IN) :: str2(:)
[4349]	311	!------------------------------------------------------------------------------------------------------------------------------
[4046]	312	CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
	313	INTEGER :: k
	314	IF(SIZE(str2)==0) RETURN
	315	s2 = str2; CALL strClean(s2)
	316	IF(.NOT.ALLOCATED(s2)) RETURN
	317	IF(SIZE(s2) == 0) THEN; DEALLOCATE(s2); RETURN; END IF
	318	IF(.NOT.ALLOCATED(str1)) THEN
	319	str1 = s2
	320	ELSE IF(SIZE(str1)==0) THEN
	321	str1 = s2
	322	ELSE
	323	s1 = str1; CALL strClean(s1)
	324	str1 = [s1, PACK(s2, MASK= [( ALL(s1(:) /= s2(k)), k=1, SIZE(s2) )] ) ]
	325	END IF
	326	END SUBROUTINE strReduce_2
	327	!==============================================================================================================================
	328
	329
	330	!==============================================================================================================================
[4349]	331	!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
	332	!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0 ============================
[4046]	333	!==============================================================================================================================
[5745]	334	INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
[5001]	335	IMPLICIT NONE
[4046]	336	CHARACTER(LEN=*), INTENT(IN) :: str(:), s
	337	DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
	338	IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
	339	END FUNCTION strIdx_1
	340	!==============================================================================================================================
	341	FUNCTION strIdx_m(str, s, n) RESULT(out)
[5001]	342	IMPLICIT NONE
[4046]	343	CHARACTER(LEN=*), INTENT(IN) :: str(:), s(:)
	344	INTEGER, OPTIONAL, INTENT(OUT) :: n
	345	INTEGER, ALLOCATABLE :: out(:)
[4349]	346	!------------------------------------------------------------------------------------------------------------------------------
[4046]	347	INTEGER :: k
	348	out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
	349	IF(PRESENT(n)) n = COUNT(out(:)/=0)
	350	END FUNCTION strIdx_m
	351	!==============================================================================================================================
	352
	353
	354	!==============================================================================================================================
	355	!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
	356	!==============================================================================================================================
[5001]	357	FUNCTION strFind_1(str, s, n) RESULT(out)
	358	IMPLICIT NONE
[4046]	359	CHARACTER(LEN=*), INTENT(IN) :: str(:), s
	360	INTEGER, OPTIONAL, INTENT(OUT) :: n
	361	INTEGER, ALLOCATABLE :: out(:)
[4349]	362	!------------------------------------------------------------------------------------------------------------------------------
[4046]	363	INTEGER :: k
	364	out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
	365	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
[5001]	366	END FUNCTION strFind_1
[4046]	367	!==============================================================================================================================
[5001]	368	FUNCTION strFind_m(str, s, n) RESULT(out)
	369	IMPLICIT NONE
	370	CHARACTER(LEN=*), INTENT(IN) :: str(:), s(:)
	371	INTEGER, OPTIONAL, INTENT(OUT) :: n
	372	INTEGER, ALLOCATABLE :: out(:)
	373	!------------------------------------------------------------------------------------------------------------------------------
	374	INTEGER :: k
	375	out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
	376	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
	377	END FUNCTION strFind_m
	378	!==============================================================================================================================
	379	FUNCTION intFind_1(i,j,n) RESULT(out)
	380	IMPLICIT NONE
[4046]	381	INTEGER, INTENT(IN) :: i(:), j
	382	INTEGER, OPTIONAL, INTENT(OUT) :: n
	383	INTEGER, ALLOCATABLE :: out(:)
[4349]	384	!------------------------------------------------------------------------------------------------------------------------------
[4046]	385	INTEGER :: k
	386	out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
	387	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
[5001]	388	END FUNCTION intFind_1
[4046]	389	!==============================================================================================================================
[5001]	390	FUNCTION intFind_m(i,j,n) RESULT(out)
	391	IMPLICIT NONE
	392	INTEGER, INTENT(IN) :: i(:), j(:)
[4046]	393	INTEGER, OPTIONAL, INTENT(OUT) :: n
	394	INTEGER, ALLOCATABLE :: out(:)
[4349]	395	!------------------------------------------------------------------------------------------------------------------------------
[4046]	396	INTEGER :: k
[5001]	397	out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
	398	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
	399	END FUNCTION intFind_m
	400	!==============================================================================================================================
	401	FUNCTION booFind(l,n) RESULT(out)
	402	IMPLICIT NONE
[5745]	403	LOGICAL, INTENT(IN) :: l(:)
[5001]	404	INTEGER, OPTIONAL, INTENT(OUT) :: n
	405	INTEGER, ALLOCATABLE :: out(:)
	406	!------------------------------------------------------------------------------------------------------------------------------
	407	INTEGER :: k
[4046]	408	out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
	409	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
[5001]	410	END FUNCTION booFind
[4046]	411	!==============================================================================================================================
	412
	413
	414	!==============================================================================================================================
[5747]	415	!=== DUPLICATE A VECTOR "v(:)" "n" times ======================================================================================
	416	!==============================================================================================================================
	417	SUBROUTINE dupl_s(v, n, vdup)
	418	CHARACTER(LEN=*), INTENT(IN) :: v(:)
	419	INTEGER, INTENT(IN) :: n
	420	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vdup(:)
	421	!------------------------------------------------------------------------------------------------------------------------------
	422	INTEGER :: nv, i
	423	nv = SIZE(v)
	424	ALLOCATE(vdup(n*nv))
	425	DO i = 1, n; vdup(1+(i-1)nv:inv) = v; END DO
	426	END SUBROUTINE dupl_s
	427	!==============================================================================================================================
	428	SUBROUTINE dupl_i(v, n, vdup)
	429	INTEGER, INTENT(IN) :: v(:)
	430	INTEGER, INTENT(IN) :: n
	431	INTEGER, ALLOCATABLE, INTENT(OUT) :: vdup(:)
	432	!------------------------------------------------------------------------------------------------------------------------------
	433	INTEGER :: nv, i
	434	nv = SIZE(v)
	435	ALLOCATE(vdup(n*nv))
	436	DO i = 1, n; vdup(1+(i-1)nv:inv) = v; END DO
	437	END SUBROUTINE dupl_i
	438	!==============================================================================================================================
	439	SUBROUTINE dupl_r(v, n, vdup)
	440	REAL, INTENT(IN) :: v(:)
	441	INTEGER, INTENT(IN) :: n
	442	REAL, ALLOCATABLE, INTENT(OUT) :: vdup(:)
	443	!------------------------------------------------------------------------------------------------------------------------------
	444	INTEGER :: nv, i
	445	nv = SIZE(v)
	446	ALLOCATE(vdup(n*nv))
	447	DO i = 1, n; vdup(1+(i-1)nv:inv) = v; END DO
	448	END SUBROUTINE dupl_r
	449	!==============================================================================================================================
	450	SUBROUTINE dupl_l(v, n, vdup)
	451	LOGICAL, INTENT(IN) :: v(:)
	452	INTEGER, INTENT(IN) :: n
	453	LOGICAL, ALLOCATABLE, INTENT(OUT) :: vdup(:)
	454	!------------------------------------------------------------------------------------------------------------------------------
	455	INTEGER :: nv, i
	456	nv = SIZE(v)
	457	ALLOCATE(vdup(n*nv))
	458	DO i = 1, n; vdup(1+(i-1)nv:inv) = v; END DO
	459	END SUBROUTINE dupl_l
	460	!==============================================================================================================================
	461
	462
	463	!==============================================================================================================================
[4046]	464	!=== GET THE INDEX IN "rawList" OF THE 1ST APPEARANCE OF ONE OF THE "del(:)" SEPARATORS (0 IF NONE OF THEM ARE PRESENT)
	465	!=== IF lSc == .TRUE.: * SKIP HEAD SIGNS OR EXPONENTS SIGNS THAT SHOULD NOT BE CONFUSED WITH SEPARATORS
	466	!=== * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
	467	!==============================================================================================================================
[5745]	468	LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
[5001]	469	IMPLICIT NONE
[4046]	470	CHARACTER(LEN=*), INTENT(IN) :: rawList !--- String in which delimiters have to be identified
	471	CHARACTER(LEN=*), INTENT(IN) :: del(:) !--- List of delimiters
	472	INTEGER, INTENT(IN) :: ibeg !--- Start index
	473	INTEGER, INTENT(OUT) :: idx !--- Index of the first identified delimiter in "rawList"
	474	INTEGER, INTENT(OUT) :: idel !--- Index of the identified delimiter (0 if idx==0)
[5745]	475	LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation
[4348]	476	!------------------------------------------------------------------------------------------------------------------------------
[4363]	477	INTEGER :: idx0 !--- Used to display an identified non-numeric string
[4046]	478	lerr = .FALSE.
[4348]	479	idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList"
[4046]	480	IF(.NOT.PRESENT(lSc)) RETURN !--- No need to check exceptions for numbers => finished
	481	IF(.NOT. lSc ) RETURN !--- No need to check exceptions for numbers => finished
[4348]	482
	483	!=== No delimiter found: the whole string must be a valid number
	484	IF(idx == 0) THEN !--- No element of "del" in "rawList"
[4349]	485	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- String must be a number
[4348]	486	IF(lerr) idx = LEN_TRIM(rawList); RETURN !--- Set idx so that rawList(ibeg:idx-1) = whole string
[4046]	487	END IF
[4348]	488
[5001]	489	lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN !--- The front delimiter is different from +/-: error
	490	IF( idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string head is a valid number
[4348]	491
	492	!=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
	493	idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel) !--- Keep start index because idx is recycled
[4046]	494	IF(idx == 0) THEN
[4349]	495	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- No other delimiter: whole string must be a valid numb
[4046]	496	IF(lerr) idx = idx0; RETURN
	497	END IF
[4349]	498	lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
[4348]	499
[4046]	500	CONTAINS
	501
[4348]	502	!------------------------------------------------------------------------------------------------------------------------------
[5745]	503	INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
[4348]	504	!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
	505	!--- "id" is the index in "del(:)" of the first delimiter found.
[4349]	506	IMPLICIT NONE
[4348]	507	CHARACTER(LEN=*), INTENT(IN) :: str, del(:)
[4046]	508	INTEGER, INTENT(IN) :: ib
	509	INTEGER, INTENT(OUT) :: id
[4348]	510	!------------------------------------------------------------------------------------------------------------------------------
[4349]	511	DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
	512	IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
[4046]	513	END FUNCTION strIdx1
	514
	515	END FUNCTION strIdx_prv
	516	!==============================================================================================================================
	517
	518
	519	!==============================================================================================================================
	520	!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
	521	!==============================================================================================================================
[5745]	522	LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
[5001]	523	IMPLICIT NONE
[4046]	524	CHARACTER(LEN=*), INTENT(IN) :: rawList
	525	CHARACTER(LEN=*), INTENT(IN) :: delimiter
	526	INTEGER, INTENT(OUT) :: nb
	527	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	528	!------------------------------------------------------------------------------------------------------------------------------
[4046]	529	LOGICAL :: ll
	530	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
[4358]	531	lerr = strCount_1m(rawList, [delimiter], nb, ll)
[4046]	532	END FUNCTION strCount_11
	533	!==============================================================================================================================
[5745]	534	LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
[5001]	535	IMPLICIT NONE
[4046]	536	CHARACTER(LEN=*), INTENT(IN) :: rawList(:)
	537	CHARACTER(LEN=*), INTENT(IN) :: delimiter
	538	INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
	539	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	540	!------------------------------------------------------------------------------------------------------------------------------
[4046]	541	LOGICAL :: ll
	542	INTEGER :: id
	543	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
[4358]	544	lerr = .TRUE.
[4046]	545	ALLOCATE(nb(SIZE(rawList)))
	546	DO id = 1, SIZE(rawList)
[4358]	547	lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
[4046]	548	END DO
	549	END FUNCTION strCount_m1
	550	!==============================================================================================================================
[5745]	551	LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
[5001]	552	IMPLICIT NONE
[4046]	553	CHARACTER(LEN=*), INTENT(IN) :: rawList
	554	CHARACTER(LEN=*), INTENT(IN) :: delimiter(:)
	555	INTEGER, INTENT(OUT) :: nb
	556	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	557	!------------------------------------------------------------------------------------------------------------------------------
[4046]	558	INTEGER :: ib, ie, jd, nr
	559	LOGICAL :: ll
	560	CHARACTER(LEN=1024) :: r
	561	lerr = .FALSE.
	562	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
	563	r = TRIM(ADJUSTL(rawList))
	564	nr = LEN_TRIM(r); IF(nr == 0) RETURN
	565	nb = 1; ib = 1
	566	DO
	567	lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
[5746]	568	CALL msg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll = lerr); IF(lerr) RETURN
[4349]	569	IF(ie == 0 .OR. jd == 0) EXIT
[4046]	570	ib = ie + LEN(delimiter(jd))
	571	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
	572	nb = nb + 1
	573	END DO
	574	END FUNCTION strCount_1m
	575	!==============================================================================================================================
	576
	577
	578	!==============================================================================================================================
	579	!=== Purpose: Parse "delimiter"-separated list "rawList" into the pair keys(:), vals(:). ====================================
	580	!=== Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
	581	!==============================================================================================================================
[5745]	582	LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
[5001]	583	IMPLICIT NONE
[4046]	584	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter
	585	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
[4348]	586	INTEGER, OPTIONAL, INTENT(OUT) :: n
[4046]	587	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
[4348]	588	!------------------------------------------------------------------------------------------------------------------------------
	589	CHARACTER(LEN=1024) :: r
[4349]	590	INTEGER :: nr, nk
[4348]	591	lerr = .FALSE.
	592	r = TRIM(ADJUSTL(rawList))
	593	nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
[5001]	594	nk = countK() !--- COUNT THE ELEMENTS
	595	CALL parseK(keys) !--- PARSE THE KEYS
	596	IF(PRESENT(vals)) CALL parseV(vals) !--- PARSE <key>=<val> PAIRS
	597	IF(PRESENT(n)) n = nk !--- RETURN THE NUMBER OF KEYS
[4348]	598
	599	CONTAINS
	600
[4349]	601	!------------------------------------------------------------------------------------------------------------------------------
[5745]	602	INTEGER FUNCTION countK() RESULT(nkeys)
[5001]	603	!--- Get the number of elements after parsing.
[4349]	604	IMPLICIT NONE
	605	!------------------------------------------------------------------------------------------------------------------------------
[5001]	606	INTEGER :: ib, ie, nl
	607	nkeys = 1; ib = 1; nl = LEN(delimiter)
[4348]	608	DO
	609	ie = INDEX(rawList(ib:nr), delimiter)+ib-1 !--- Determine the next separator start index
	610	IF(ie == ib-1) EXIT
[5001]	611	ib = ie + nl
	612	DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr) !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
	613	ib = ib + 1
	614	END DO !--- Skip spaces before next chain
	615	nkeys = nkeys+1
	616	END DO
	617	END FUNCTION countK
	618
	619	!------------------------------------------------------------------------------------------------------------------------------
	620	SUBROUTINE parseK(keys)
	621	!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
	622	IMPLICIT NONE
	623	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
	624	!------------------------------------------------------------------------------------------------------------------------------
	625	INTEGER :: ib, ie, ik
	626	ALLOCATE(keys(nk))
	627	ib = 1
	628	DO ik = 1, nk
	629	ie = INDEX(rawList(ib:nr), delimiter)+ib-1 !--- Determine the next separator start index
	630	IF(ie == ib-1) EXIT
	631	keys(ik) = r(ib:ie-1) !--- Get the ikth key
[4348]	632	ib = ie + LEN(delimiter)
	633	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
	634	END DO
[5001]	635	keys(ik) = r(ib:nr) !--- Get the last key
	636	END SUBROUTINE parseK
[4348]	637
[4349]	638	!------------------------------------------------------------------------------------------------------------------------------
[5001]	639	SUBROUTINE parseV(vals)
	640	!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
	641	IMPLICIT NONE
	642	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
[4349]	643	!------------------------------------------------------------------------------------------------------------------------------
[5001]	644	CHARACTER(LEN=maxlen) :: key
	645	INTEGER :: ik, ix
	646	ALLOCATE(vals(nk))
	647	DO ik = 1, nk; key = keys(ik)
	648	vals(ik) = ''
	649	ix = INDEX(key, '='); IF(ix == 0) CYCLE !--- First "=" index in "key"
	650	vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
	651	keys(ik) = ADJUSTL(key(1:ix-1))
	652	END DO
	653	END SUBROUTINE parseV
[4348]	654
	655	END FUNCTION strParse
[4046]	656	!==============================================================================================================================
[5745]	657	LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
[5001]	658	IMPLICIT NONE
[4046]	659	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter(:)
	660	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:) !--- Parsed keys vector
[4348]	661	INTEGER, OPTIONAL, INTENT(OUT) :: n !--- Length of the parsed vector
	662	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:) !--- Values for <name>=<value> keys
[4046]	663	LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Take care about numbers in scientific notation
	664	INTEGER, OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:) !--- Indexes of the separators in "delimiter(:)" vector
[4348]	665	!------------------------------------------------------------------------------------------------------------------------------
[4046]	666	CHARACTER(LEN=1024) :: r
	667	INTEGER :: nr, ik, nk, ib, ie, jd
	668	LOGICAL :: ll
	669	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
[5001]	670	lerr = strCount_1m(rawList, delimiter, nk, ll)
	671	CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
[4046]	672
	673	!--- FEW ALLOCATIONS
	674	ALLOCATE(keys(nk))
	675	IF(PRESENT(vals)) ALLOCATE(vals(nk))
	676	IF(PRESENT(id)) ALLOCATE(id(nk-1))
	677	IF(PRESENT(n)) n = nk
	678
	679	!--- PARSING
	680	r = TRIM(ADJUSTL(rawList))
	681	nr = LEN_TRIM(r); IF(nr == 0) RETURN
	682	ib = 1
	683	DO ik = 1, nk-1
[5001]	684	lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
	685	CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
[4046]	686	keys(ik) = r(ib:ie-1)
	687	IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik)) !--- Parse a <key>=<val> pair
	688	IF(PRESENT(id )) id(ik) = jd !--- Index in "delimiter(:)" of the "ik"th delimiter
	689	ib = ie + LEN_TRIM( delimiter(jd) ) !--- Length of the current delimiter
	690	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
	691	END DO
	692	keys(nk) = r(ib:nr)
	693	IF(PRESENT(vals)) CALL parseKeys(keys(nk), vals(nk)) !--- Parse a <key>=<val> pair
	694
	695	CONTAINS
	696
[4349]	697	!------------------------------------------------------------------------------------------------------------------------------
[4046]	698	SUBROUTINE parseKeys(key, val)
[5001]	699	IMPLICIT NONE
[4046]	700	CHARACTER(LEN=*), INTENT(INOUT) :: key
	701	CHARACTER(LEN=*), INTENT(OUT) :: val
[4349]	702	!------------------------------------------------------------------------------------------------------------------------------
[4046]	703	INTEGER :: ix
	704	ix = INDEX(key, '='); IF(ix == 0) RETURN !--- First "=" index in "key"
	705	val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
	706	key = ADJUSTL(key(1:ix-1))
	707	END SUBROUTINE parseKeys
	708
	709	END FUNCTION strParse_m
	710	!==============================================================================================================================
	711
	712
	713	!==============================================================================================================================
	714	!=== String substitution: replace "key" by "val" each time it appears in "str".
	715	!==============================================================================================================================
	716	SUBROUTINE strReplace_1(str, key, val, lsurr)
[5001]	717	IMPLICIT NONE
[4046]	718	CHARACTER(LEN=*), INTENT(INOUT) :: str !--- Main string
	719	CHARACTER(LEN=*), INTENT(IN) :: key, val !--- "key" will be replaced by "val"
	720	LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted
[4349]	721	!------------------------------------------------------------------------------------------------------------------------------
[4046]	722	INTEGER :: i0, ix, nk, ns
	723	LOGICAL :: lsur, lb, le
	724	lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
	725	nk = LEN_TRIM(key)
	726	i0 = 1
	727	DO
	728	ns = LEN_TRIM(str)
	729	ix = INDEX(str(i0:ns), TRIM(key)) !--- First appearance index of "key" in "s", starting from index "i0"
	730	IF(ix == 0) EXIT
	731	ix = ix + i0 -1
	732	IF(lsur) THEN !--- Key must be surrounded by special characters
	733	!--- lb=.TRUE.: key is at the very beginning of "str" or located after a special character
	734	lb = ix ==1; IF(.NOT.lb) lb = INDEX('+-*/()^', str(ix-1 :ix-1 ))/=0
	735	!--- le=.TRUE.: key is at the very end of "str" or located before a special character
	736	le = ix+nk-1==ns; IF(.NOT.le) le = INDEX('+-*/()^', str(ix+nk:ix+nk))/=0
	737	IF(.NOT.(lb.AND.le)) THEN; i0 = i0 + nk; CYCLE; END IF
	738	END IF
	739	str = str(1:ix-1)//TRIM(val)//str(ix+nk:ns)
	740	END DO
	741	END SUBROUTINE strReplace_1
	742	!==============================================================================================================================
	743	SUBROUTINE strReplace_m(str, key, val, lsurr)
[5001]	744	IMPLICIT NONE
[4046]	745	CHARACTER(LEN=*), INTENT(INOUT) :: str(:) !--- Main strings vector
	746	CHARACTER(LEN=*), INTENT(IN) :: key, val !--- "key" will be replaced by "val"
	747	LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted
	748	INTEGER :: k
	749	LOGICAL :: ll
	750	ll=.FALSE.; IF(PRESENT(lsurr)) ll=lsurr
	751	DO k=1, SIZE(str); CALL strReplace_1(str(k),key,val,ll); END DO
	752	END SUBROUTINE strReplace_m
	753	!==============================================================================================================================
	754
	755
	756	!==============================================================================================================================
	757	!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
	758	!==============================================================================================================================
[5749]	759	FUNCTION horzcat_s00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	760	IMPLICIT NONE
[5750]	761	CHARACTER(LEN=*), INTENT(IN) :: v0
	762	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
[4046]	763	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[5750]	764	INTEGER :: ncol, iv, i
[5001]	765	LOGICAL :: pre(9)
[4349]	766	!------------------------------------------------------------------------------------------------------------------------------
[5749]	767	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	768	ncol = 1+COUNT(pre)
	769	ALLOCATE(out(ncol))
	770	out(1) = v0
[5750]	771	i = 2
	772	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	773	SELECT CASE(iv-1)
[5750]	774	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
	775	CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
[5749]	776	END SELECT
[5750]	777	i = i+1
[4046]	778	END DO
[5001]	779	END FUNCTION horzcat_s00
[4046]	780	!==============================================================================================================================
[5749]	781	FUNCTION horzcat_s10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	782	IMPLICIT NONE
[5749]	783	CHARACTER(LEN=*), INTENT(IN) :: v0(:), v1
	784	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
[5001]	785	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
[5750]	786	tmp = horzcat_s00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	787	out = [v0 , tmp]
[5001]	788	END FUNCTION horzcat_s10
	789	!==============================================================================================================================
[5749]	790	FUNCTION horzcat_s11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	791	IMPLICIT NONE
[5750]	792	CHARACTER(LEN=*), INTENT(IN) :: v0(:)
	793	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[4046]	794	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
[5750]	795	INTEGER :: nrow, ncol, iv, i
[5749]	796	LOGICAL :: pre(9)
[4349]	797	!------------------------------------------------------------------------------------------------------------------------------
[5749]	798	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	799	nrow = SIZE(v0)
[5001]	800	ncol = 1+COUNT(pre)
[5750]	801	IF(pre(1)) nrow = MAX(nrow,SIZE(v1)); IF(pre(2)) nrow = MAX(nrow,SIZE(v2)); IF(pre(3)) nrow = MAX(nrow,SIZE(v3))
	802	IF(pre(4)) nrow = MAX(nrow,SIZE(v4)); IF(pre(5)) nrow = MAX(nrow,SIZE(v5)); IF(pre(6)) nrow = MAX(nrow,SIZE(v6))
	803	IF(pre(7)) nrow = MAX(nrow,SIZE(v7)); IF(pre(8)) nrow = MAX(nrow,SIZE(v8)); IF(pre(9)) nrow = MAX(nrow,SIZE(v9))
	804	ALLOCATE(out(nrow, ncol)); out(:,:) = ''
	805	out(1:SIZE(v0),1) = v0
	806	i = 2
	807	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	808	SELECT CASE(iv-1)
[5750]	809	CASE(1); out(1:SIZE(v1),i) = v1; CASE(2); out(1:SIZE(v2),i) = v2; CASE(3); out(1:SIZE(v3),i) = v3
	810	CASE(4); out(1:SIZE(v4),i) = v4; CASE(5); out(1:SIZE(v5),i) = v5; CASE(6); out(1:SIZE(v5),i) = v6
	811	CASE(7); out(1:SIZE(v7),i) = v7; CASE(8); out(1:SIZE(v8),i) = v8; CASE(9); out(1:SIZE(v9),i) = v9
[5749]	812	END SELECT
[5750]	813	i = i+1
[4046]	814	END DO
[5001]	815	END FUNCTION horzcat_s11
[4046]	816	!==============================================================================================================================
[5749]	817	FUNCTION horzcat_s21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	818	IMPLICIT NONE
[5749]	819	CHARACTER(LEN=*), INTENT(IN) :: v0(:,:), v1(:)
	820	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5750]	821	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
	822	tmp = horzcat_s11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	823	out = horzcat_s22(v0, tmp)
[5001]	824	END FUNCTION horzcat_s21
	825	!==============================================================================================================================
[5750]	826	FUNCTION horzcat_s22(v0, v1) RESULT(out)
	827	IMPLICIT NONE
	828	CHARACTER(LEN=*), INTENT(IN) :: v0(:,:), v1(:,:)
	829	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), pk(:), tmp(:,:)
	830	INTEGER :: n0, n1, nrow
	831	n0 = SIZE(v0,1)
	832	n1 = SIZE(v1,1)
	833	nrow = MAX(n0, n1)
	834	IF(n0 == n1) THEN
	835	pk = PACK(v0, .TRUE.); pk = [pk, PACK(v1, .TRUE.)]
	836	ELSE IF(n0 /= nrow) THEN
	837	ALLOCATE(tmp(nrow,SIZE(v0,2))); tmp(:,:) = ''; tmp(1:n0,:) = v0(:,:); pk = PACK(tmp, .TRUE.); pk = [pk, PACK(v1, .TRUE.)]
	838	ELSE
	839	ALLOCATE(tmp(nrow,SIZE(v1,2))); tmp(:,:) = ''; tmp(1:n1,:) = v1(:,:); pk = PACK(tmp, .TRUE.); pk = [PACK(v0, .TRUE.), pk]
	840	END IF
	841	out = RESHAPE(pk, SHAPE=[nrow, SIZE(v0, 2) + SIZE(v1, 2)])
	842	END FUNCTION horzcat_s22
	843	!==============================================================================================================================
[5749]	844	FUNCTION horzcat_i00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	845	IMPLICIT NONE
[5750]	846	INTEGER, INTENT(IN) :: v0
	847	INTEGER, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
[4046]	848	INTEGER, ALLOCATABLE :: out(:)
[5750]	849	INTEGER :: ncol, iv, i
[5001]	850	LOGICAL :: pre(9)
[4349]	851	!------------------------------------------------------------------------------------------------------------------------------
[5749]	852	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
[5750]	853	ncol = 1+COUNT(pre)
[5001]	854	ALLOCATE(out(ncol))
[5749]	855	out(1) = v0
[5750]	856	i = 2
	857	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	858	SELECT CASE(iv-1)
[5750]	859	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
	860	CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
[5749]	861	END SELECT
[5750]	862	i = i+1
[4046]	863	END DO
[5001]	864	END FUNCTION horzcat_i00
[4046]	865	!==============================================================================================================================
[5749]	866	FUNCTION horzcat_i10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	867	IMPLICIT NONE
[5749]	868	INTEGER, INTENT(IN) :: v0(:), v1
	869	INTEGER, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
[5001]	870	INTEGER, ALLOCATABLE :: out(:), tmp(:)
[5750]	871	tmp = horzcat_i00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	872	out = [v0, tmp]
[5001]	873	END FUNCTION horzcat_i10
	874	!==============================================================================================================================
[5749]	875	FUNCTION horzcat_i11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	876	IMPLICIT NONE
[5750]	877	INTEGER, INTENT(IN) :: v0(:)
	878	INTEGER, OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[4046]	879	INTEGER, ALLOCATABLE :: out(:,:)
[5750]	880	INTEGER :: siz(9), nrow, ncol, iv, i, n
	881	LOGICAL :: pre(9)
[4349]	882	!------------------------------------------------------------------------------------------------------------------------------
[5749]	883	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	884	nrow = SIZE(v0)
[5001]	885	ncol = 1+COUNT(pre)
[4046]	886	ALLOCATE(out(nrow, ncol))
[5749]	887	out(:,1) = v0
[5750]	888	i = 2
	889	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	890	SELECT CASE(iv-1)
[5750]	891	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)
	892	CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
[5749]	893	END SELECT
[5750]	894	IF(n /= nrow) THEN; CALL msg("Can't concatenate integer vectors of differing lengths"); STOP; END IF
	895	SELECT CASE(iv-1)
	896	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
	897	CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
	898	END SELECT
	899	i = i+1
[4046]	900	END DO
[5001]	901	END FUNCTION horzcat_i11
[4046]	902	!==============================================================================================================================
[5749]	903	FUNCTION horzcat_i21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	904	IMPLICIT NONE
[5749]	905	INTEGER, INTENT(IN) :: v0(:,:), v1(:)
	906	INTEGER, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5001]	907	INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
[5750]	908	tmp = horzcat_i11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	909	out = horzcat_i22(v0, tmp)
[5001]	910	END FUNCTION horzcat_i21
	911	!==============================================================================================================================
[5750]	912	FUNCTION horzcat_i22(v0, v1) RESULT(out)
	913	IMPLICIT NONE
	914	INTEGER, INTENT(IN) :: v0(:,:), v1(:,:)
	915	INTEGER, ALLOCATABLE :: out(:,:), pk(:)
	916	INTEGER :: nrow, ncol
	917	nrow = SIZE(v0,1)
	918	ncol = SIZE(v0,2)+SIZE(v1,2)
	919	IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate integer arrays of differing rows numbers"); STOP; END IF
	920	ALLOCATE(out(nrow, ncol))
	921	pk = PACK(v0, .TRUE.)
	922	pk = [pk, PACK(v1, .TRUE.)]
	923	out = RESHAPE(pk, SHAPE=[nrow, ncol])
	924	END FUNCTION horzcat_i22
	925	!==============================================================================================================================
[5749]	926	FUNCTION horzcat_r00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	927	IMPLICIT NONE
[5750]	928	REAL(KIND=REAL32), INTENT(IN) :: v0
	929	REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
[5748]	930	REAL(KIND=REAL32), ALLOCATABLE :: out(:)
[5750]	931	INTEGER :: ncol, iv, i
[5001]	932	LOGICAL :: pre(9)
[4349]	933	!------------------------------------------------------------------------------------------------------------------------------
[5749]	934	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
[5001]	935	ncol = 1+COUNT(pre)
	936	ALLOCATE(out(ncol))
[5749]	937	out(1) = v0
[5750]	938	i = 2
	939	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	940	SELECT CASE(iv-1)
[5750]	941	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
	942	CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
[5749]	943	END SELECT
[5750]	944	i = i+1
[4046]	945	END DO
[5001]	946	END FUNCTION horzcat_r00
[4046]	947	!==============================================================================================================================
[5749]	948	FUNCTION horzcat_r10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	949	IMPLICIT NONE
[5749]	950	REAL(KIND=REAL32), INTENT(IN) :: v0(:), v1
	951	REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
[5748]	952	REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
[5750]	953	tmp = horzcat_r00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	954	out = [v0 , tmp]
[5001]	955	END FUNCTION horzcat_r10
	956	!==============================================================================================================================
[5749]	957	FUNCTION horzcat_r11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	958	IMPLICIT NONE
[5750]	959	REAL(KIND=REAL32), INTENT(IN) :: v0(:)
	960	REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5748]	961	REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
[5750]	962	INTEGER :: siz(9), nrow, ncol, iv, i, n
[5748]	963	LOGICAL :: pre(9)
[4349]	964	!------------------------------------------------------------------------------------------------------------------------------
[5749]	965	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	966	nrow = SIZE(v0)
[5001]	967	ncol = 1+COUNT(pre)
[4046]	968	ALLOCATE(out(nrow, ncol))
[5749]	969	out(:,1) = v0
[5750]	970	i = 2
	971	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	972	SELECT CASE(iv-1)
[5750]	973	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)
	974	CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
[5749]	975	END SELECT
[5750]	976	IF(n /= nrow) THEN; CALL msg("Can't concatenate real vectors of differing lengths"); STOP; END IF
	977	SELECT CASE(iv-1)
	978	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
	979	CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
	980	END SELECT
	981	i = i+1
[4046]	982	END DO
[5001]	983	END FUNCTION horzcat_r11
[4046]	984	!==============================================================================================================================
[5749]	985	FUNCTION horzcat_r21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	986	IMPLICIT NONE
[5749]	987	REAL(KIND=REAL32), INTENT(IN) :: v0(:,:), v1(:)
	988	REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5748]	989	REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
[5749]	990	tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
[5750]	991	out = horzcat_r22(v0, tmp)
[5001]	992	END FUNCTION horzcat_r21
	993	!==============================================================================================================================
[5750]	994	FUNCTION horzcat_r22(v0, v1) RESULT(out)
	995	IMPLICIT NONE
	996	REAL(KIND=REAL32), INTENT(IN) :: v0(:,:), v1(:,:)
	997	REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), pk(:)
	998	INTEGER :: nrow, ncol
	999	nrow = SIZE(v0,1)
	1000	ncol = SIZE(v0,2)+SIZE(v1,2)
	1001	IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate real arrays of differing rows numbers"); STOP; END IF
	1002	ALLOCATE(out(nrow, ncol))
	1003	pk = PACK(v0, .TRUE.)
	1004	pk = [pk, PACK(v1, .TRUE.)]
	1005	out = RESHAPE(pk, SHAPE=[nrow, ncol])
	1006	END FUNCTION horzcat_r22
	1007	!==============================================================================================================================
[5749]	1008	FUNCTION horzcat_d00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	1009	IMPLICIT NONE
[5750]	1010	REAL(KIND=REAL64), INTENT(IN) :: v0
	1011	REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
[5748]	1012	REAL(KIND=REAL64), ALLOCATABLE :: out(:)
[5750]	1013	INTEGER :: ncol, iv, i
	1014	LOGICAL :: pre(9)
[4349]	1015	!------------------------------------------------------------------------------------------------------------------------------
[5749]	1016	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
[5001]	1017	ncol = 1+COUNT(pre)
	1018	ALLOCATE(out(ncol))
[5749]	1019	out(1) = v0
[5750]	1020	i = 2
	1021	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	1022	SELECT CASE(iv-1)
[5750]	1023	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
	1024	CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
[5749]	1025	END SELECT
[5750]	1026	i = i+1
[4046]	1027	END DO
[5001]	1028	END FUNCTION horzcat_d00
[4046]	1029	!==============================================================================================================================
[5749]	1030	FUNCTION horzcat_d10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	1031	IMPLICIT NONE
[5749]	1032	REAL(KIND=REAL64), INTENT(IN) :: v0(:), v1
	1033	REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
[5748]	1034	REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
[5750]	1035	tmp = horzcat_d00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	1036	out = [v0 , tmp]
[5001]	1037	END FUNCTION horzcat_d10
	1038	!==============================================================================================================================
[5749]	1039	FUNCTION horzcat_d11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	1040	IMPLICIT NONE
[5750]	1041	REAL(KIND=REAL64), INTENT(IN) :: v0(:)
	1042	REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5748]	1043	REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
[5750]	1044	INTEGER :: siz(9), nrow, ncol, iv, i, n
[5749]	1045	LOGICAL :: pre(9)
[4349]	1046	!------------------------------------------------------------------------------------------------------------------------------
[5749]	1047	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	1048	nrow = SIZE(v0)
[5001]	1049	ncol = 1+COUNT(pre)
[4046]	1050	ALLOCATE(out(nrow, ncol))
[5750]	1051	out(:,1) = v0
	1052	i = 2
	1053	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
[5749]	1054	SELECT CASE(iv-1)
[5750]	1055	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)
	1056	CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
[5749]	1057	END SELECT
[5750]	1058	IF(n /= nrow) THEN; CALL msg("Can't concatenate double vectors of differing lengths"); STOP; END IF
	1059	SELECT CASE(iv-1)
	1060	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
	1061	CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
	1062	END SELECT
	1063	i = i+1
[4046]	1064	END DO
[5001]	1065	END FUNCTION horzcat_d11
[4046]	1066	!==============================================================================================================================
[5749]	1067	FUNCTION horzcat_d21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
[5001]	1068	IMPLICIT NONE
[5749]	1069	REAL(KIND=REAL64), INTENT(IN) :: v0(:,:), v1(:)
	1070	REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
[5748]	1071	REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
[5750]	1072	tmp = horzcat_d11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	1073	out = horzcat_d22(v0, tmp)
[5001]	1074	END FUNCTION horzcat_d21
	1075	!==============================================================================================================================
[5750]	1076	FUNCTION horzcat_d22(v0, v1) RESULT(out)
	1077	IMPLICIT NONE
	1078	REAL(KIND=REAL64), INTENT(IN) :: v0(:,:), v1(:,:)
	1079	REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), pk(:)
	1080	INTEGER :: nrow, ncol
	1081	nrow = SIZE(v0,1)
	1082	ncol = SIZE(v0,2)+SIZE(v1,2)
	1083	IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate double arrays of differing rows numbers"); STOP; END IF
	1084	ALLOCATE(out(nrow, ncol))
	1085	pk = PACK(v0, .TRUE.)
	1086	pk = [pk, PACK(v1, .TRUE.)]
	1087	out = RESHAPE(pk, SHAPE=[nrow, ncol])
	1088	END FUNCTION horzcat_d22
	1089	!==============================================================================================================================
	1090	FUNCTION horzcat_l00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
	1091	IMPLICIT NONE
	1092	LOGICAL, INTENT(IN) :: v0
	1093	LOGICAL, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
	1094	LOGICAL, ALLOCATABLE :: out(:)
	1095	INTEGER :: ncol, iv, i
	1096	LOGICAL :: pre(9)
	1097	!------------------------------------------------------------------------------------------------------------------------------
	1098	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	1099	ncol = 1+COUNT(pre)
	1100	ALLOCATE(out(ncol))
	1101	out(1) = v0
	1102	i = 2
	1103	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
	1104	SELECT CASE(iv-1)
	1105	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
	1106	CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
	1107	END SELECT
	1108	i = i+1
	1109	END DO
	1110	END FUNCTION horzcat_l00
	1111	!==============================================================================================================================
	1112	FUNCTION horzcat_l10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
	1113	IMPLICIT NONE
	1114	LOGICAL, INTENT(IN) :: v0(:), v1
	1115	LOGICAL, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
	1116	LOGICAL, ALLOCATABLE :: out(:), tmp(:)
	1117	tmp = horzcat_l00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	1118	out = [v0, tmp]
	1119	END FUNCTION horzcat_l10
	1120	!==============================================================================================================================
	1121	FUNCTION horzcat_l11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
	1122	IMPLICIT NONE
	1123	LOGICAL, INTENT(IN) :: v0(:)
	1124	LOGICAL, OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
	1125	LOGICAL, ALLOCATABLE :: out(:,:)
	1126	INTEGER :: siz(9), nrow, ncol, iv, i, n
	1127	LOGICAL :: pre(9)
	1128	!------------------------------------------------------------------------------------------------------------------------------
	1129	pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
	1130	ncol = 1+COUNT(pre)
	1131	nrow = SIZE(v0)
	1132	ALLOCATE(out(nrow, ncol))
	1133	out(:,1) = v0
	1134	i = 2
	1135	DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
	1136	SELECT CASE(iv-1)
	1137	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)
	1138	CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
	1139	END SELECT
	1140	IF(n /= nrow) THEN; CALL msg("Can't concatenate logical vectors of differing lengths"); STOP; END IF
	1141	SELECT CASE(iv-1)
	1142	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
	1143	CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
	1144	END SELECT
	1145	i = i+1
	1146	END DO
	1147	END FUNCTION horzcat_l11
	1148	!==============================================================================================================================
	1149	FUNCTION horzcat_l21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
	1150	IMPLICIT NONE
	1151	LOGICAL, INTENT(IN) :: v0(:,:), v1(:)
	1152	LOGICAL, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
	1153	LOGICAL, ALLOCATABLE :: out(:,:), tmp(:,:)
	1154	tmp = horzcat_l11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
	1155	out = horzcat_l22(v0, tmp)
	1156	END FUNCTION horzcat_l21
	1157	!==============================================================================================================================
	1158	FUNCTION horzcat_l22(v0, v1) RESULT(out)
	1159	IMPLICIT NONE
	1160	LOGICAL, INTENT(IN) :: v0(:,:), v1(:,:)
	1161	LOGICAL, ALLOCATABLE :: out(:,:), pk(:)
	1162	INTEGER :: nrow, ncol
	1163	nrow = SIZE(v0,1)
	1164	ncol = SIZE(v0,2)+SIZE(v1,2)
	1165	IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate logical arrays of differing rows numbers"); STOP; END IF
	1166	ALLOCATE(out(nrow, ncol))
	1167	pk = PACK(v0, .TRUE.)
	1168	pk = [pk, PACK(v1, .TRUE.)]
	1169	out = RESHAPE(pk, SHAPE=[nrow, ncol])
	1170	END FUNCTION horzcat_l22
	1171	!==============================================================================================================================
[4046]	1172
	1173
	1174	!==============================================================================================================================
[5751]	1175	!=== DISPLAY A TABLE COMPOSED OF HORIZONTALLY CONCATENATED COLUMN VECTORS =====================================================
	1176	!==============================================================================================================================
[4046]	1177	!=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display.
[4193]	1178	!=== * nRowMax lines are displayed (default: all lines)
[5751]	1179	!=== * nColMax characters (default: as long as needed) are displayed at most on a line.
	1180	!=== - narrow tables are stacked horizontally as much as possible (ie: total width must stay lower than nColMax) .
	1181	!=== - wide tables are cut into several sub-tables of columns subsets, with the first nHead columns repeated.
	1182	!=== * titles can be a vector (one element each column) or an array (dim 1: number of lines ; dim 2: number of columns)
[4046]	1183	!==============================================================================================================================
[5751]	1184	LOGICAL FUNCTION dispTable_1(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
[5001]	1185	IMPLICIT NONE
[5751]	1186	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	1187	CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (one each column, single line)
	1188	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	1189	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	1190	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	1191	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
	1192	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows
	1193	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line
	1194	INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display
	1195	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen)
	1196	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
[4349]	1197	!------------------------------------------------------------------------------------------------------------------------------
[5751]	1198	lerr = dispTable_2(p, RESHAPE(titles, [1,SIZE(titles)]), s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub)
	1199	END FUNCTION dispTable_1
	1200	!==============================================================================================================================
	1201	LOGICAL FUNCTION dispTable_2(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
	1202	IMPLICIT NONE
	1203	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	1204	CHARACTER(LEN=*), INTENT(IN) :: titles(:,:) !--- TITLES (one each column, possibly more than one line)
	1205	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	1206	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	1207	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	1208	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
	1209	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows
	1210	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line
	1211	INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display
	1212	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen)
	1213	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
	1214	!------------------------------------------------------------------------------------------------------------------------------
	1215	INTEGER, PARAMETER :: nm = 1
	1216	INTEGER, ALLOCATABLE :: n(:), nmx(:)
	1217	INTEGER :: nRmx, nCmx, nHd, unt, ib, ic, ie, it, nt, ncol, k, l, l0
	1218	CHARACTER(LEN=maxlen), ALLOCATABLE :: c(:,:), c1(:,:), m(:)
	1219	CHARACTER(LEN=maxlen) :: subn
	1220
	1221	!=== CONVERT THE ELEMENTS INTO A STRINGS ARRAY
	1222	lerr = convertTable(p, titles, c, s, i, r, rFmt, sub); IF(lerr) RETURN
	1223
	1224	!=== GET VALUES FOR REMAINING OPTIONAL ARGUMENTS
	1225	nRmx= SIZE(c, 1); IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax) !--- Maximum number of lines to print
	1226	nCmx= maxTableWidth; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax) !--- Maximum number of characters each line
	1227	nHd = 0; IF(PRESENT(nHead)) nHd = nHead !--- Number of front columns to duplicate
	1228	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages
	1229	subn= 'dispTable'; IF(PRESENT(sub)) subn= sub !--- Calling subroutine name
	1230
	1231	!=== SMALL WIDTH TABLE: STACK AS MUCH VERTICAL SECTIONS HORIZONTALLY AS POSSIBLE CONSIDERING nColMax. UNTOUCHED OTHERWISE.
	1232	n = tableCellsWidth(c)+2*nm
	1233	c1 = gatherTable(c, n, SIZE(titles, 1), nRmx, nCmx, subn)
	1234	ncol = SIZE(c1, DIM=2)
	1235	IF(ncol /= SIZE(c,2)) n = tableCellsWidth(c1)+2*nm !--- UPDATE "n(:)" IF "c" HAS BEEN STACKED
	1236
	1237	nCmx = 48
	1238
	1239	!=== HIGH WIDTH TABLE: CUT IT INTO SUB-TABLES, WITH THE FIRST "nHead" COLUMNS REPEATED IN EACH OF THEM
	1240	!--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts)
	1241	IF(SUM(n+1)-1 > nCmx .AND. ncol > 1) THEN
	1242	l0 = 1 + LEN_TRIM(subn) + SUM(n(1:nHd)+1)
	1243
	1244	!=== DETERMINE THE NUMBER "nt" OF SUB-TABLES
	1245	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
	1246
	1247	!=== GET THE INDEX OF THE LAST COLUMN FOR EACH SUB-TABLE
	1248	ALLOCATE(nmx(nt))
	1249	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
	1250	nmx(nt) = ncol
	1251
	1252	!=== DISPLAY THE SUB-TABLES
	1253	DO it = 1, nt
	1254	ie = nmx(it); ib = nHd+1; IF(it > 1) ib = nmx(it-1)+1
	1255	m = buildTable(cat(c1(:,1:nHd),c1(:,ib:ie)), nm, SIZE(titles, 1))
	1256	DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO; CALL msg('', subn, unit=unt)
	1257	END DO
	1258	ELSE
	1259	!=== DISPLAY THE SINGLE TABLE
	1260	m = buildTable(c1, nm, SIZE(titles,1))
	1261	DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO
	1262	END IF
	1263
	1264	CONTAINS
	1265
	1266	FUNCTION tableCellsWidth(t) RESULT(n) !=== COMPUTE FOR EACH COLUMN THE MIMIMUM WIDTH TO DISPLAY ELEMENTS WITHOUT TRUNCATION
	1267	CHARACTER(LEN=*), INTENT(IN) :: t(:,:)
	1268	INTEGER, ALLOCATABLE :: n(:)
	1269	INTEGER :: i, j
	1270	n = [(MAXVAL([(LEN_TRIM(t(i,j)), i=1, SIZE(t,1))], DIM=1), j=1, SIZE(t,2))]
	1271	END FUNCTION tableCellsWidth
	1272
	1273	END FUNCTION dispTable_2
	1274	!==============================================================================================================================
	1275
	1276
	1277	!==============================================================================================================================
	1278	!--- Concatenate horizontally the table d0(:,:) so that:
	1279	!=== * total width (number of characters per line) remains lower than nColMax (default: 256 characters)
	1280	!=== * total number of lines remains lower than nRowMax (default: all lines are kept)
	1281	!=== If the table d0 starts with nTitle /= 0 lines for titles, they are duplicated at each section top.
	1282	!==============================================================================================================================
	1283	FUNCTION gatherTable(d0, n, nTitle, nRowMax, nColMax, sub) RESULT(d1)
	1284	IMPLICIT NONE
	1285	CHARACTER(LEN=*), INTENT(IN) :: d0(:,:) !--- Input strings array
	1286	INTEGER, INTENT(IN) :: n(:) !--- Maximum width of elements in each column (excluding separator)
	1287	INTEGER, OPTIONAL, INTENT(IN) :: nTitle !--- Number of rows for titles
	1288	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of rows
	1289	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters each line
	1290	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
	1291	CHARACTER(LEN=maxlen), ALLOCATABLE :: d1(:,:) !--- Array of horizontally gathered sections
	1292	INTEGER :: nr0, nc0, nr1, nc1 !--- Row and columns numbers for original and gathered array
	1293	INTEGER :: ih, nh, nv !--- Index and number of stacked sections
	1294	INTEGER :: nttl, nrMx, ncMx !--- Titles number and effective max. row and columns numbers
	1295	INTEGER :: nrem, nr, ir0, icb, ice
	1296	nr0 = SIZE(d0, DIM=1)
	1297	nc0 = SIZE(d0, DIM=2)
	1298	nttl = 0; IF(PRESENT(nTitle)) nttl = nTitle
	1299	ncMx = 256; IF(PRESENT(nColMax)) ncMx = MIN(nCmx, nColMax)
	1300	nrMx = nr0; IF(PRESENT(nRowMax)) nrMx = MIN(nrMx, nRowMax)
	1301	nh = MAX(1, ncMx/SUM(n+1)) !--- Max. horiz. stackabled sections for ncMx (+1: last separator)
	1302	nv = 1+(nr0-nttl-1)/nh !--- Corresponding number ofvertical elements per section
	1303	nh = 1+(nr0-nttl-1)/nv !--- Effective number of sections
	1304	nr1 = MIN(nrMx,1+ nttl+(nr0-nttl-1)/nh); nc1 = nc0*nh !--- Shape of the stacked array
	1305	ALLOCATE(d1(nr1,nc1))
	1306	nrem = nr0 !--- Remaining values to fill in
	1307	DO ih = 1, nh
	1308	nr = MAX(0,MIN(nr1,nrem)-nttl); nrem=nrem-nr !--- Number of copied rows in ith section (excluding titles)
	1309	ir0 = nttl+(ih-1)*(nr1-nttl) !--- Row start index in d1
	1310	ice = ih*nc0; icb = ice-nc0+1 !--- Column end and start indices in d1
	1311	d1(1:nttl, icb:ice) = d0(1:nttl, :) !--- Copy titles line(s)
	1312	d1(1+nttl:nr+nttl,icb:ice) = d0(1+ir0:nr+ir0,:) !--- Copy ith section
	1313	IF(nr1 == nr + nttl) CYCLE
	1314	d1(1+nr+nttl:nr1, icb:ice) =' ' !--- Fill missing cells with a space
	1315	END DO
	1316	END FUNCTION gatherTable
	1317	!==============================================================================================================================
	1318
	1319
	1320	!==============================================================================================================================
	1321	!--- Convert a set of columns of different natures ("s"trings, "i"ntegers, "r"eals) into a strings table. Default value
	1322	!=== * p: profile giving the order to pick up columns from "s", "i" and "r" to construct "c(:,:)". mandatory
	1323	!=== * t: titles, one per variable (2nd index), possibly on several lines (1st index). mandatory
	1324	!=== * c: assembled array mandatory
	1325	!=== * s: horizontally stacked string column vectors of values /
	1326	!=== * i: horizontally stacked integer column vectors of values /
	1327	!=== * r: horizontally stacked real column vectors of values /
	1328	!=== * rFmt: format for real conversion *
	1329	!=== * sub: calling subroutine name (for error messages) /
	1330	!=== NOTE: The vectors s, i and r do not have necessarly the same length. Empty elements are filled at the end.
	1331	!==============================================================================================================================
	1332	LOGICAL FUNCTION convertTable(p, t, c, s, i, r, rFmt, sub) RESULT(lerr)
	1333	IMPLICIT NONE
	1334	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	1335	CHARACTER(LEN=*), INTENT(IN) :: t(:,:) !--- TITLES (ONE EACH COLUMN)
	1336	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: c(:,:) !--- CONVERTED STRINGS TABLE
	1337	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	1338	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	1339	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	1340	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
	1341	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
	1342	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1343	CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
[5751]	1344	CHARACTER(LEN=maxlen) :: rFm, subn
	1345	CHARACTER(LEN=1) :: sp = '\|' !--- Table cells separator
	1346	INTEGER :: it, is, ii, ir, ic, nmx
	1347	INTEGER :: nt, ns, ni, nr, ncol
	1348	LOGICAL :: ls, li, lr, ll
	1349	rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals
[4120]	1350	subn = ''; IF(PRESENT(sub)) subn = sub
[4046]	1351	ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
[5751]	1352	ns = 0; ni = 0; nr = 0; ncol = 0
	1353	ncol = LEN_TRIM(p) !--- Number of columns of the table
	1354	nt = SIZE(t,1)
[4046]	1355
	1356	!--- CHECK ARGUMENTS COHERENCE
[5751]	1357	lerr = .NOT.ANY([ls,li,lr])
	1358	CALL msg('missing argument(s) "s", "i" and/or "r"', subn, lerr)
	1359	IF(lerr) RETURN
	1360	lerr = ncol /= SIZE(t,2)
	1361	CALL msg('display map "p" length and titles number mismatch', subn, lerr)
	1362	IF(lerr) RETURN
	1363	IF(ls) THEN; ns = SIZE(s,1)
	1364	lerr = COUNT([(p(ic:ic)=='s', ic=1, ncol)]) /= SIZE(s,2)
	1365	CALL msg('display map "p" and string arguments mismatch: nb(p=="s")/=SIZE(s,2)', subn, lerr)
	1366	IF(lerr) RETURN
[4046]	1367	END IF
[5751]	1368	IF(li) THEN; ni = SIZE(i,1)
	1369	lerr = COUNT([(p(ic:ic)=='i', ic=1, ncol)]) /= SIZE(i,2)
	1370	CALL msg('display map "p" and integer arguments mismatch: nb(p=="i")/=SIZE(i,2)', subn, lerr)
	1371	IF(lerr) RETURN
[4046]	1372	END IF
[5751]	1373	IF(lr) THEN; nr = SIZE(r,1)
	1374	lerr = COUNT([(p(ic:ic)=='r', ic=1, ncol)]) /= SIZE(r,2)
	1375	CALL msg('display map "p" and real arguments mismatch: nb(p=="r")/=SIZE(r,2)', subn, lerr)
	1376	IF(lerr) RETURN
[4046]	1377	END IF
[5751]	1378	! lerr = (ls.AND.li .AND. ns /= ni) .OR. (li.AND.lr .AND. ni /= nr) .OR. (lr.AND.ls .AND. nr /= ns)
	1379	! CALL msg('mismatching rows numbers for at least "s", "i" or "r"', subn, lerr)
	1380	! IF(lerr) RETURN
	1381	nmx = MAX(ns, ni, nr) + nt
[4046]	1382
	1383	!--- Assemble the vectors into a strings array in the order indicated by "pattern"
[5751]	1384	ALLOCATE(c(nmx,ncol))
[4046]	1385	is = 1; ii = 1; ir = 1
	1386	DO ic = 1, ncol
[5751]	1387	c(1:nt,ic) = t(1:nt,ic) !--- Add titles line(s)
[4046]	1388	SELECT CASE(p(ic:ic))
[5751]	1389	CASE('s'); c(1+nt:nmx,ic) = s(:,is) ; is = is + 1 !--- Add string elements
	1390	CASE('i'); c(1+nt:nmx,ic) = num2str(i(:,ii) ); ii = ii + 1 !--- Add integer elements
	1391	CASE('r'); c(1+nt:nmx,ic) = num2str(r(:,ir),rFm); ir = ir + 1 !--- Add real elements
[4046]	1392	END SELECT
[4193]	1393	END DO
[5751]	1394	CALL cleanZeros(c) !--- Remove useless zeros in converted numbers
[4046]	1395
[5751]	1396	END FUNCTION convertTable
	1397	!==============================================================================================================================
	1398
	1399
	1400	!==============================================================================================================================
	1401	!--- Build a table from the string array "d(:,:)" as a vector of assembled lines (to be printed as messages).
	1402	!=== * each column has the minimum width "n(j)" needed to display the elements "d(:,j)" with at least "nm" spaces each side.
	1403	!=== * the structure of a cell is: <n1 spaces><TRIM(d(i,j))><n2 spaces>\| (pay attention to the end separator "\|")
	1404	!=== * n1 and n2 depend on the justification (three methods available) and give a total width of "n(j)", as expected.
	1405	!=== * each cell ends with the separator "\|", except the last one
	1406	!=== * nTitle/=0 means that the first "nTitle" lines will be separated from the rest of the table with an underline.
	1407	!==============================================================================================================================
	1408	FUNCTION buildTable(d, nm, nTitle) RESULT(m)
	1409	IMPLICIT NONE
	1410	CHARACTER(LEN=*), INTENT(IN) :: d(:,:) !--- Input array
	1411	INTEGER, INTENT(IN) :: nm !--- Number of spaces before and after values
	1412	INTEGER, OPTIONAL, INTENT(IN) :: nTitle !--- Number of rows for titles
	1413	CHARACTER(LEN=10*maxlen), ALLOCATABLE :: m(:) !--- Lines to issue as messages to display the table
	1414	CHARACTER(LEN=1) :: sp = '\|' !--- Separator
	1415	INTEGER :: ir, ic, nr, nc, i, j, n(SIZE(d,2)), nttl, id, p
	1416	nr = SIZE(d, DIM=1); nc = SIZE(d, DIM=2) !--- Dimensions of the table
	1417	nttl = 0; IF(PRESENT(nTitle)) nttl = nTitle
	1418	n = [(MAXVAL([(LEN_TRIM(d(i,j)), i=1, nr)], DIM=1), j=1, nc)] + 2*nm
	1419	ALLOCATE(m(nr+1)) !--- Allocate the vector (+1 for header line)
	1420	i = 1
	1421	DO ir = 1, nr
	1422	IF(ir <= nttl) CALL centerJustified(d(ir,:), n, i, m(i))
	1423	IF(ir == nttl) CALL headerLine( n, i, m(i))
	1424	IF(ir > nttl) CALL leftJustified(d(ir,:), n, i, m(i))
[4046]	1425	END DO
	1426
[5751]	1427	CONTAINS
	1428
	1429	SUBROUTINE leftJustified(d, n, i, r)
	1430	CHARACTER(LEN=*), INTENT(IN) :: d(:)
	1431	INTEGER, INTENT(IN) :: n(:)
	1432	CHARACTER(LEN=*), INTENT(INOUT) :: r
	1433	INTEGER, INTENT(INOUT) :: i
	1434	r = ''
	1435	DO id = 1, nc; r = TRIM(r)//REPEAT(' ',nm)//TRIM(d(id))//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//sp; END DO
	1436	r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed
	1437	END SUBROUTINE leftJustified
	1438
	1439	SUBROUTINE centerJustified(d, n, i, r)
	1440	CHARACTER(LEN=*), INTENT(IN) :: d(:)
	1441	INTEGER, INTENT(IN) :: n(:)
	1442	INTEGER, INTENT(INOUT) :: i
	1443	CHARACTER(LEN=*), INTENT(INOUT) :: r
	1444	INTEGER :: p
	1445	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
	1446	r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed
	1447	END SUBROUTINE centerJustified
	1448
	1449	SUBROUTINE rightJustified(d, n, i, r)
	1450	CHARACTER(LEN=*), INTENT(IN) :: d(:)
	1451	INTEGER, INTENT(IN) :: n(:)
	1452	INTEGER, INTENT(INOUT) :: i
	1453	CHARACTER(LEN=*), INTENT(INOUT) :: r
	1454	r = ''; DO id = 1, nc; r = TRIM(r)//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//TRIM(d(id))//REPEAT(' ',nm)//sp; END DO
	1455	r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed
	1456	END SUBROUTINE rightJustified
	1457
	1458	SUBROUTINE headerLine(n, i, r)
	1459	INTEGER, INTENT(IN) :: n(:)
	1460	INTEGER, INTENT(INOUT) :: i
	1461	CHARACTER(LEN=*), INTENT(INOUT) :: r
	1462	r = ''; DO id= 1 , nc; r = TRIM(r)//REPEAT('-',n(id))//'+'; END DO
	1463	r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final '+' removed
	1464	END SUBROUTINE headerLine
	1465
	1466	END FUNCTION buildTable
[4046]	1467	!==============================================================================================================================
	1468
[5751]	1469
[4046]	1470	!==============================================================================================================================
[5745]	1471	LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
[5001]	1472	IMPLICIT NONE
[4046]	1473	INTEGER, INTENT(IN) :: unt !--- Output unit
	1474	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	1475	CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (ONE EACH COLUMN)
	1476	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	1477	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	1478	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	1479	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
	1480	LOGICAL, OPTIONAL, INTENT(IN) :: llast !--- Last variable: no final ','
[4349]	1481	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1482	CHARACTER(LEN=maxlen) :: rFm, el
	1483	CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
	1484	CHARACTER(LEN=:), ALLOCATABLE :: sp, row
	1485	INTEGER :: is, ii, ir, nrow, ic
	1486	INTEGER :: ns, ni, nr, ncol, np
	1487	INTEGER, ALLOCATABLE :: n(:)
	1488	LOGICAL :: ls, li, lr, la
	1489	rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals
	1490	ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
	1491	lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN !--- Nothing to do
	1492	la = .FALSE.; IF(PRESENT(llast)) la = llast
	1493
	1494	!--- CHECK ARGUMENTS COHERENCE
	1495	ns = 0; ni = 0; nr = 0; np = LEN_TRIM(p); ncol = 0
	1496	IF(ls) THEN; ns = SIZE(s, DIM=1); ncol = ncol + SIZE(s, DIM=2)
	1497	lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, DIM=2)
	1498	END IF
	1499	IF(li) THEN; ni = SIZE(i, DIM=1); ncol = ncol + SIZE(i, DIM=2)
	1500	lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, DIM=2)
	1501	END IF
	1502	IF(lr) THEN; nr = SIZE(r, DIM=1); ncol = ncol + SIZE(r, DIM=2)
	1503	lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
	1504	END IF
[5746]	1505	CALL msg('display map "p" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
	1506	lerr = ncol /= SIZE(titles); CALL msg('"titles" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
	1507	lerr = ls.AND.li.AND.ns/=ni; CALL msg('string and integer arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
	1508	lerr = ls.AND.lr.AND.ns/=nr; CALL msg( 'string and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
	1509	lerr = li.AND.lr.AND.ni/=nr; CALL msg( 'integer and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
[4046]	1510
	1511	!--- Allocate the assembled quantities array
	1512	nrow = MAX(ns,ni,nr)+1
	1513	ALLOCATE(d(nrow,ncol), n(ncol))
	1514
	1515	!--- Assemble the vectors into a strings array in the order indicated by "pattern"
	1516	is = 1; ii = 1; ir = 1
	1517	DO ic = 1, ncol
	1518	d(1,ic) = TRIM(titles(ic))
	1519	SELECT CASE(p(ic:ic))
[5748]	1520	CASE('s'); d(2:nrow,ic) = s(:,is) ; is = is + 1
	1521	CASE('i'); d(2:nrow,ic) = num2str(i(:,ii) ); ii = ii + 1
	1522	CASE('r'); d(2:nrow,ic) = num2str(r(:,ir),rFm); ir = ir + 1
[4046]	1523	END SELECT
[4193]	1524	END DO
	1525	CALL cleanZeros(d)
	1526	DO ic = 1, ncol
[4046]	1527	n(ic) = 0; DO ir=1, nrow; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
	1528	IF(needQuotes(d(2,ic)) .AND. ic/=1) n(ic) = n(ic) + 2 !--- For quotes, using second line only
	1529	END DO
	1530
	1531	!--- Display the strings array as a table
	1532	DO ir = 1, nrow
	1533	row = ''; sp = ' '; IF(TRIM(d(ir,1)) /= '') sp = ' = '
	1534	DO ic = 1, ncol
	1535	el = d(ir,ic); IF(ic /= 1) el = addQuotes_1(el)
	1536	row = row//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el))//sp
	1537	sp = ' '; IF(ic /= ncol-1) CYCLE
	1538	IF(TRIM(d(MIN(ir+1,nrow),1)) /= '' .AND. (ir /= nrow .OR. .NOT.la)) sp = ' , '
	1539	END DO
	1540	WRITE(unt,'(a)')TRIM(row)
	1541	END DO
	1542
	1543	!--- End of section
	1544	IF(la) THEN
	1545	WRITE(unt,'(a)')'/'
	1546	WRITE(unt,'(a)')
	1547	END IF
	1548
	1549	END FUNCTION dispNameList
	1550	!==============================================================================================================================
	1551
	1552
	1553	!==============================================================================================================================
[5753]	1554	!=== DISPLAY OUTLIERS IN TABLES ===============================================================================================
	1555	!==============================================================================================================================
	1556	!=== lerr = dispOutliers_1(ll(:), a(:[:]), n(:), err_msg, nam(:), sub, nRowmax, nColMax, unit)
	1557	!=== * ll linearized mask of outliers
	1558	!=== * a linearized fields:
	1559	!=== a(:) all the fields are linearized (all contane
	1560	!=== Behaviour depends on ll(:), n(:) and nam(:). We note hereafter nv = SIZE(nam).
	1561	!===
	1562	!=== 1) if SIZE(ll) == PRODUCT(n) and nv==1 or "nam" is unspecified: outliers of a single variable are displayed
	1563	!=== i[,j[,k]] \| nam \|
	1564	!=== ----------+-----------------+
	1565	!=== [,[,*]] \| val(i[,j[,k]]) \|
	1566	!=== ... \| ... \|
	1567	!===
	1568	!===
	1569	!=== 2) if SIZE(ll) == PRODUCT(n) and nv>1: "nv" tables of outliers are displayed, each having its own mask
	1570	!=== i[,j] \| var(1)
	1571	!=== ------+--------------
	1572	!=== [,] \| val(i[,j],1)
	1573	!=== ... \| ...
	1574	!===
	1575	!=== ...
	1576	!===
	1577	!=== i[,j] \| var(nv)
	1578	!=== ------+---------------
	1579	!=== [,] \| val(i[,j],nv)
	1580	!=== ... \| ...
	1581	!===
	1582	!===
	1583	!=== 3) if SIZE(ll) = PRODUCT(n(1:SIZE(n)-1): outliers of "nv" variables are displayed, all with mask "ll(:)"
	1584	!=== i[,j] \| var(1) \| var(2) \| ... \| var(nv)
	1585	!=== ------+--------------+---------------+-- ... --+---------------
	1586	!=== [,] \| val(i[,j],1) \| val(i[,j],2) \| ... \| val(i[,j],nv)
	1587	!=== ... \| ... \| ... \| ... \| ...
	1588	!===
	1589	!=== NOTES:
	1590	!=== * in cases 2 and 3, SIZE(nam) MUST be equal to n(SIZE(n)).
	1591	!=== * for the sake of readability, narrow tables (compared to the max. width "nColMax") are horizontally stacked.
	1592	!=== Here is the result in the case 1:
	1593	!=== i[,j[,k]] \| nam \| i[,j[,k]] \| nam \| ... \| i[,j[,k]] \| nam
	1594	!=== ----------+-----------------+-----------+-----------------+-- ... --+-----------+-----------------
	1595	!=== [,[,]] \| val(i[,j[,k]]) \| [,[,]] \| val(i[,j[,k]]) \| ... \| [,[,*]] \| val(i[,j[,k]])
	1596	!=== ... \| ... \| ... \| ... \| ... \| ... \| ...
	1597	!=== * conversly, in case 3, too wide tables are displayed as several sub-tables.
	1598	!=== * too long tables are truncated to nRowMax lines (excluding titles lines).
	1599	!==============================================================================================================================
	1600	LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, unit) RESULT(lerr)
	1601	IMPLICIT NONE
	1602	! Display outliers list in tables
	1603	! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
	1604	LOGICAL, INTENT(IN) :: ll(:) !--- Linearized mask of outliers
	1605	REAL, INTENT(IN) :: a(:) !--- Linearized array of values
	1606	INTEGER, INTENT(IN) :: n(:) !--- Profile before linearization
	1607	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: err_msg, nam(:), sub !--- Error message, variables and calling subroutine names
	1608	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of lines to display (default: all)
	1609	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters per line (default: 2048)
	1610	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout)
	1611	!------------------------------------------------------------------------------------------------------------------------------
	1612	CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:), vnm(:), c(:,:)
	1613	LOGICAL, ALLOCATABLE :: m(:), ld(:)
	1614	INTEGER, ALLOCATABLE :: ki(:), kj(:)
	1615	INTEGER :: rk, ib, ie, itr, nm, unt, nRmx, nCmx, iv, nv, np
	1616	CHARACTER(LEN=maxlen) :: mes, subn, fm='(f12.9)', p
	1617	lerr = .FALSE.
	1618
	1619	IF(.NOT.ANY(ll)) RETURN !--- No outliers -> finished
	1620
	1621	mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg !--- Error message
	1622	vnm = ['a']; IF(PRESENT(nam)) vnm = nam !--- Variables names
	1623	subn= 'dispOutliers'; IF(PRESENT(sub)) subn= sub !--- Calling subroutine name
	1624	nRmx= SIZE(a); IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!--- Maximum number of lines to print
	1625	nCmx= 2048; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!--- Maximum number of characters each line
	1626	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages
	1627
	1628	rk = SIZE(n) !--- Rank of "a" before linearization
	1629	nv = SIZE(vnm) !--- Number of variables
	1630	np = PRODUCT(n(1:rk-1)) !--- Number of points per var (in the multiple vars case)
	1631	lerr = rk>3; CALL msg('can display field with rank <=3 only !', subn, lerr, unt); IF(lerr) RETURN
	1632	lerr = n(rk) == 1; CALL msg('degenerated last dim: n(SIZE(n)) = 1 !', subn, lerr, unt); IF(lerr) RETURN
	1633	lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', subn, lerr, unt); IF(lerr) RETURN
	1634	lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', subn, lerr, unt); IF(lerr) RETURN
	1635	lerr = ALL([PRODUCT(n),np] /= SIZE(ll))
	1636	CALL msg('ll" length must be either PROD(n) or PROD(n(1:rk-1))', subn, lerr, unt); IF(lerr) RETURN
	1637
	1638	!============================================================================================================================
	1639	IF(SIZE(ll) == PRODUCT(n)) THEN !=== ll(:) IS A MASK FOR THE WHOLE a(:) VECTOR ===========
	1640	!============================================================================================================================
	1641	p = 's'//REPEAT('r',nv) !--- Display map: one string, "nv" reals
	1642	IF(nv == 1) THEN !=== SINGLE VARIABLE
	1643	CALL buildTitle(n, vnm, t) !--- Build titles list "t" for a single variable
	1644	CALL buildCoord(n, ll, c) !--- Masked ("ll") coordinates vector "c"
	1645	lerr = dispTable(p, t, s=c, r=cat(PACK(a,ll)), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, unit=unt, sub=subn)
	1646	ELSE !=== MULTIPLE VARIABLES
	1647	DO iv = 1, nv
	1648	CALL buildTitle(n, vnm(iv:iv), t) !--- Titles list "t" for the "iv"th variables
	1649	CALL buildCoord(n(1:rk-1), ll, c) !--- Masked ("ll") coordinates vector "c"
	1650	ib = 1+(iv-1)*np; ie = ib+np
	1651	lerr = dispTable(p, t, s=c, r=cat(PACK(a(ib:ie),ll(ib:ie))), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, &
	1652	unit=unt, sub=subn)
	1653	CALL msg("can't display outliers table", subn, lerr, unt); IF(lerr) RETURN
	1654	END DO
	1655	END IF
	1656	!============================================================================================================================
	1657	ELSE !=== ll(:) IS A MASK FOR EACH TRACER STACKED IN a(:) VECTOR
	1658	!============================================================================================================================
	1659	CALL buildTitle(n, vnm, t) !--- Build titles list "t" for all the variable
	1660	CALL duplicate(ll, nv, ld) !--- "ll" concatenated "nv" times
	1661	CALL buildCoord(n(1:rk-1), ll, c) !--- Masked ("ll") coordinates vector "c"
	1662	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)
	1663	!============================================================================================================================
	1664	END IF
	1665	!============================================================================================================================
	1666	CALL msg("can't display outliers table", subn, lerr, unt)
	1667
	1668	CONTAINS
	1669
	1670	SUBROUTINE buildTitle(n, vname, title) !=== BUILD TITLES: [COORD. NAME, THE VARIABLE(S) NAME(S)]
	1671	INTEGER, INTENT(IN) :: n(:)
	1672	CHARACTER(LEN=maxlen), INTENT(IN) :: vname(:)
	1673	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: title(:)
	1674	INTEGER :: rk
	1675	rk = SIZE(n)
	1676	ALLOCATE(title(1+SIZE(vname)))
	1677	title(2:SIZE(vname)+1) = vname
	1678	title(1) = 'i'
	1679	IF(rk >= 2) title(1) = TRIM(title(1))//', j'
	1680	IF(rk >= 3) title(1) = TRIM(title(1))//', k'
	1681	END SUBROUTINE buildTitle
	1682
	1683	SUBROUTINE buildCoord(n, mask, coord) !=== BUILD MASKED COORDINATES OK FOR "s" ARG OF dispTable
	1684	INTEGER, INTENT(IN) :: n(:)
	1685	LOGICAL, INTENT(IN) :: mask(:)
	1686	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: coord(:,:)
	1687	CHARACTER(LEN=maxlen) :: sj, sk
	1688	INTEGER :: i, j, k, m(3), rk, ic
	1689	rk = SIZE(n)
	1690	m(:) = 1; m(1:rk) = n(:)
	1691	ALLOCATE(coord(1,COUNT(mask)))
	1692	ic = 0
	1693	DO k = 1, m(3); sk = ', '//num2str(k)
	1694	DO j = 1, m(2); sj = ', '//num2str(j)
	1695	DO i = 1, m(1)
	1696	IF(.NOT.mask(i+m(1)(j+m(2)k))) CYCLE
	1697	ic = ic+1
	1698	coord(ic,1) = num2str(i)
	1699	IF(rk >= 2) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sj)
	1700	IF(rk >= 3) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sk)
	1701	END DO
	1702	END DO
	1703	END DO
	1704	END SUBROUTINE buildCoord
	1705
	1706	END FUNCTION dispOutliers_1
	1707	!==============================================================================================================================
	1708	LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, unit) RESULT(lerr)
	1709	IMPLICIT NONE
	1710	! Display outliers list in tables
	1711	! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
	1712	LOGICAL, INTENT(IN) :: ll(:) !--- Linearized mask of outliers
	1713	REAL, INTENT(IN) :: a(:,:) !--- Linearized array of values
	1714	INTEGER, INTENT(IN) :: n(:) !--- Profile before linearization
	1715	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: err_msg, nam(:), sub !--- Error message, variables and calling subroutine names
	1716	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of lines to display (default: all)
	1717	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters per line (default: 2048)
	1718	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout)
	1719	!------------------------------------------------------------------------------------------------------------------------------
	1720	lerr = dispOutliers_1(ll, PACK(a, MASK=.TRUE.), n, err_msg, nam, sub, nRowmax, nColMax, unit)
	1721	END FUNCTION dispOutliers_2
	1722	!==============================================================================================================================
	1723
	1724
	1725	!==============================================================================================================================
[4046]	1726	!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
	1727	!==============================================================================================================================
[5745]	1728	LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
[5001]	1729	IMPLICIT NONE
[4046]	1730	CHARACTER(LEN=*), INTENT(IN) :: str
	1731	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
[4349]	1732	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1733	CHARACTER(LEN=maxlen) :: v
	1734	CHARACTER(LEN=1024) :: s, vv
	1735	CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
	1736	INTEGER, ALLOCATABLE :: ip(:)
	1737	INTEGER :: nl, nn, i, j, im, ix
	1738	LOGICAL :: ll
	1739	s = str
	1740
	1741	!--- Check wether the parenthesis are correctly formed
	1742	ll = strCount(s,'(',nl)
	1743	ll = strCount(s,')',nn)
	1744	lerr = nl /= nn
[5746]	1745	CALL msg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr); IF(lerr) RETURN
[4046]	1746	nl = 2*nl-1
	1747
	1748	!--- Build vectors ; vl: parenthesis-separated elements ; ip: parenthesis types (1: opening, 2: closing)
	1749	ALLOCATE(ip(nl-1),vl(nl))
	1750	j = 1; im = 1
	1751	DO i = 1, LEN_TRIM(str)
	1752	ix = INDEX('()', str(i:i))
	1753	IF(ix == 0) CYCLE
	1754	ip(j) = ix
	1755	vl(j) = str(im:i-1)
	1756	j = j + 1; im = i + 1
	1757	END DO
	1758	vl(j) = str(im:LEN_TRIM(str))
	1759
	1760	!--- Search for each opening/closing parenthesis pair
	1761	DO WHILE(nl > 1)
	1762	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
[5001]	1763	lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
[4046]	1764	v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
	1765	vv = v//REPEAT(' ',768)
	1766	IF(i == 1) THEN; ip = ip(3:nl-1); vl = [ vv, vl(4 :nl)]
	1767	ELSE IF(i == nl-1) THEN; ip = ip(1:nl-2); vl = [vl(1:nl-3), vv ]
	1768	ELSE; ip = [ip(1: i-1), ip(i+2:nl-1)]; vl = [vl(1: i-1), vv, vl(i+3:nl)]; END IF
	1769	nl = SIZE(vl)
	1770	END DO
	1771	lerr = reduceExpr_basic(vl(1), val)
	1772	END FUNCTION reduceExpr_1
	1773
	1774
	1775	!==============================================================================================================================
	1776	!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
	1777	!==============================================================================================================================
[5745]	1778	LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
[5001]	1779	IMPLICIT NONE
[4046]	1780	CHARACTER(LEN=*), INTENT(IN) :: str
	1781	CHARACTER(LEN=*), INTENT(OUT) :: val
[5748]	1782	REAL(KIND=REAL64), ALLOCATABLE :: vl(:)
[4046]	1783	INTEGER, ALLOCATABLE :: id(:)
	1784	CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
	1785	CHARACTER(LEN=1), ALLOCATABLE :: op(:)
[4349]	1786	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1787	CHARACTER(LEN=1024) :: s
[5748]	1788	REAL(KIND=REAL64) :: v, vm, vp
[4046]	1789	INTEGER :: i, ni, io
	1790	lerr = .FALSE.
	1791	IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
	1792	op = ['^','/','*','+','-'] !--- List of recognized operations
	1793	s = str
[5001]	1794	lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id) !--- Parse the values
	1795	IF(lerr) RETURN !--- Problem with the parsing
[4046]	1796	vl = str2dble(ky) !--- Conversion to doubles
[5748]	1797	lerr = ANY(vl >= HUGE(1._REAL64))
[5001]	1798	CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
	1799	IF(lerr) RETURN !--- Non-numerical values found
[4046]	1800	DO io = 1, SIZE(op) !--- Loop on known operators (order matters !)
	1801	DO i = SIZE(id), 1, -1 !--- Loop on found operators
	1802	ni = SIZE(id)
	1803	IF(id(i) /= io) CYCLE !--- Current found operator is not op(io)
	1804	vm = vl(i); vp = vl(i+1) !--- Couple of values used for current operation
[5001]	1805	SELECT CASE(op(io)) !--- Perform operation on the two values
[4349]	1806	CASE('^'); v = vm**vp
	1807	CASE('/'); v = vm/vp
	1808	CASE(''); v = vmvp
	1809	CASE('+'); v = vm+vp
	1810	CASE('-'); v = vm-vp
[4046]	1811	END SELECT
	1812	IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
	1813	IF(i == ni) THEN; id = id(1:ni-1); ELSE; id = [id(1:i-1), id(i+1:ni )]; END IF
	1814	END DO
	1815	END DO
[5748]	1816	val = num2str(vl(1))
[4046]	1817
	1818	END FUNCTION reduceExpr_basic
	1819	!==============================================================================================================================
	1820
	1821	!==============================================================================================================================
	1822	FUNCTION reduceExpr_m(str, val) RESULT(lerr)
[5001]	1823	IMPLICIT NONE
[4046]	1824	LOGICAL, ALLOCATABLE :: lerr(:)
	1825	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	1826	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
[4349]	1827	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1828	INTEGER :: i
	1829	ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
	1830	lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
	1831	END FUNCTION reduceExpr_m
	1832	!==============================================================================================================================
	1833
	1834
	1835	!==============================================================================================================================
	1836	!=== Check whether a string is a number or not ================================================================================
	1837	!==============================================================================================================================
[5745]	1838	ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
[5001]	1839	IMPLICIT NONE
[4046]	1840	CHARACTER(LEN=*), INTENT(IN) :: str
	1841	REAL :: x
	1842	INTEGER :: e
	1843	CHARACTER(LEN=12) :: fmt
	1844	IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
	1845	WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
	1846	READ(str,fmt,IOSTAT=e) x
	1847	out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
	1848	END FUNCTION is_numeric
	1849	!==============================================================================================================================
	1850
	1851
	1852	!==============================================================================================================================
	1853	!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
	1854	!==============================================================================================================================
[5745]	1855	ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out) !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
[4987]	1856	IMPLICIT NONE
[4046]	1857	CHARACTER(LEN=*), INTENT(IN) :: str
	1858	INTEGER :: ierr
[4987]	1859	LOGICAL :: lout
	1860	READ(str,*,IOSTAT=ierr) lout
	1861	out = -HUGE(1)
	1862	IF(ierr /= 0) THEN
	1863	IF(ANY(['.false.', 'false ', 'no ', 'f ', 'n '] == strLower(str))) out = 0
	1864	IF(ANY(['.true. ', 'true ', 'yes ', 't ', 'y '] == strLower(str))) out = 1
	1865	ELSE
	1866	out = 0; IF(lout) out = 1
	1867	END IF
[4046]	1868	END FUNCTION str2bool
	1869	!==============================================================================================================================
[5745]	1870	ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
[5001]	1871	IMPLICIT NONE
[4046]	1872	CHARACTER(LEN=*), INTENT(IN) :: str
	1873	INTEGER :: ierr
	1874	READ(str,*,IOSTAT=ierr) out
	1875	IF(ierr/=0) out = -HUGE(1)
	1876	END FUNCTION str2int
	1877	!==============================================================================================================================
[5748]	1878	ELEMENTAL REAL(KIND=REAL32) FUNCTION str2real(str) RESULT(out)
[5001]	1879	IMPLICIT NONE
[4046]	1880	CHARACTER(LEN=*), INTENT(IN) :: str
	1881	INTEGER :: ierr
	1882	READ(str,*,IOSTAT=ierr) out
[5748]	1883	IF(ierr/=0) out = -HUGE(1._REAL32)
[4046]	1884	END FUNCTION str2real
	1885	!==============================================================================================================================
[5748]	1886	ELEMENTAL REAL(KIND=REAL64) FUNCTION str2dble(str) RESULT(out)
[5001]	1887	IMPLICIT NONE
[4046]	1888	CHARACTER(LEN=*), INTENT(IN) :: str
	1889	INTEGER :: ierr
	1890	READ(str,*,IOSTAT=ierr) out
[5748]	1891	IF(ierr/=0) out = -HUGE(1._REAL64)
[4046]	1892	END FUNCTION str2dble
	1893	!==============================================================================================================================
[5745]	1894	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
[5001]	1895	IMPLICIT NONE
[4046]	1896	LOGICAL, INTENT(IN) :: b
	1897	WRITE(out,*)b
	1898	out = ADJUSTL(out)
	1899	END FUNCTION bool2str
	1900	!==============================================================================================================================
[5745]	1901	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
[5001]	1902	IMPLICIT NONE
[4046]	1903	INTEGER, INTENT(IN) :: i
	1904	INTEGER, OPTIONAL, INTENT(IN) :: nDigits
[4349]	1905	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1906	WRITE(out,*)i
	1907	out = ADJUSTL(out)
	1908	IF(.NOT.PRESENT(nDigits)) RETURN
	1909	IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
	1910	END FUNCTION int2str
	1911	!==============================================================================================================================
[5745]	1912	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
[5001]	1913	IMPLICIT NONE
[5748]	1914	REAL(KIND=REAL32), INTENT(IN) :: r
[4046]	1915	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
[4349]	1916	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1917	IF( PRESENT(fmt)) WRITE(out,fmt)r
	1918	IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
	1919	out = ADJUSTL(out)
	1920	END FUNCTION real2str
	1921	!==============================================================================================================================
[5745]	1922	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
[5001]	1923	IMPLICIT NONE
[5748]	1924	REAL(KIND=REAL64), INTENT(IN) :: d
[4046]	1925	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
[4349]	1926	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1927	IF( PRESENT(fmt)) WRITE(out,fmt)d
	1928	IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
	1929	out = ADJUSTL(out)
	1930	END FUNCTION dble2str
	1931	!==============================================================================================================================
[4193]	1932	ELEMENTAL SUBROUTINE cleanZeros(s)
[5001]	1933	IMPLICIT NONE
[4193]	1934	CHARACTER(LEN=*), INTENT(INOUT) :: s
	1935	INTEGER :: ls, ix, i
	1936	IF(is_numeric(s)) THEN
	1937	ls = LEN_TRIM(s)
	1938	ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
	1939	IF(ix == 0) THEN
	1940	DO ix = ls,1,-1; IF(s(ix:ix) /= '0') EXIT; END DO; s=s(1:ix+1)
	1941	ELSE IF(INDEX(s,'.')/=0) THEN
	1942	i = ix-1; DO WHILE(s(i:i) == '0'); i = i-1; END DO; s=s(1:i)//s(ix:ls)
	1943	END IF
	1944	END IF
	1945	END SUBROUTINE cleanZeros
	1946	!==============================================================================================================================
[4046]	1947
[4349]	1948
[4046]	1949	!==============================================================================================================================
	1950	FUNCTION addQuotes_1(s) RESULT(out)
[5001]	1951	IMPLICIT NONE
[4046]	1952	CHARACTER(LEN=*), INTENT(IN) :: s
	1953	CHARACTER(LEN=:), ALLOCATABLE :: out
	1954	IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
	1955	END FUNCTION addQuotes_1
	1956	!==============================================================================================================================
	1957	FUNCTION addQuotes_m(s) RESULT(out)
[5001]	1958	IMPLICIT NONE
[4046]	1959	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1960	CHARACTER(LEN=:), ALLOCATABLE :: out(:)
[4349]	1961	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1962	INTEGER :: k, n
	1963	n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
	1964	ALLOCATE(CHARACTER(LEN=n) :: out(SIZE(s)))
	1965	DO k=1,SIZE(s)
	1966	IF(needQuotes(s(k))) THEN; out(k) = "'"//TRIM(s(k))//"'"; ELSE; out(k) = s(k); END IF
	1967	END DO
	1968	END FUNCTION addQuotes_m
	1969	!==============================================================================================================================
[5745]	1970	ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
[5001]	1971	IMPLICIT NONE
[4046]	1972	CHARACTER(LEN=*), INTENT(IN) :: s
	1973	CHARACTER(LEN=1) :: b, e
[4349]	1974	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1975	out = .TRUE.; IF(TRIM(s) == '') RETURN
	1976	b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
	1977	out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
	1978	END FUNCTION needQuotes
	1979	!==============================================================================================================================
	1980
	1981
	1982	!==============================================================================================================================
	1983	!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
	1984	!==============================================================================================================================
[5745]	1985	LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
[5001]	1986	IMPLICIT NONE
[4046]	1987	! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
	1988	! Note: Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
	1989	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	1990	LOGICAL, INTENT(IN) :: lerr(:)
	1991	CHARACTER(LEN=*), INTENT(IN) :: message, items, reason
	1992	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	1993	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1994	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
	1995	INTEGER :: i, nmx
	1996	nmx = 256; IF(PRESENT(nmax)) nmx=nmax
	1997	out = ANY(lerr); IF(.NOT.out) RETURN
	1998	CALL msg(TRIM(message)//': the following '//TRIM(items)//' are '//TRIM(reason)//':')
	1999	s = strStackm(PACK(str, MASK=lerr), ', ',nmx)
	2000	DO i=1,SIZE(s,DIM=1); CALL msg(s(i)); END DO
	2001	END FUNCTION checkList
	2002	!==============================================================================================================================
	2003
	2004
	2005	!==============================================================================================================================
	2006	!=== Remove comment in line "str", ie all the characters from the first "#" sign found in "str". ==============================
	2007	!==============================================================================================================================
	2008	SUBROUTINE removeComment(str)
[5001]	2009	IMPLICIT NONE
[4046]	2010	CHARACTER(LEN=*), INTENT(INOUT) :: str
	2011	INTEGER :: ix
	2012	ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)
	2013	END SUBROUTINE removeComment
	2014	!==============================================================================================================================
	2015
	2016
	2017	END MODULE strings_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format