Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

strings_mod.F90 @ 5422

Last change on this file since 5422 was 4368, checked in by lguez, 2 years ago
Sync latest trunk changes to Ocean_skin
File size: 85.4 KB

Rev	Line
[4046]	1	MODULE strings_mod
	2
	3	IMPLICIT NONE
	4
	5	PRIVATE
	6	PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
[4068]	7	PUBLIC :: strLower, strHead, strStack, strCount, strReduce, strClean, strIdx
	8	PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
[4046]	9	PUBLIC :: dispTable, dispOutliers, dispNameList
	10	PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
	11	PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
	12	PUBLIC :: addQuotes, testFile, checkList, removeComment, test
	13
	14	INTERFACE get_in; MODULE PROCEDURE getin_s, getin_i, getin_r, getin_l; END INTERFACE get_in
	15	INTERFACE msg; MODULE PROCEDURE msg_1, msg_m; END INTERFACE msg
	16	INTERFACE fmsg; MODULE PROCEDURE fmsg_1, fmsg_m; END INTERFACE fmsg
	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
	24	INTERFACE cat; MODULE PROCEDURE horzcat_s1, horzcat_i1, horzcat_r1, &
	25	! horzcat_d1, horzcat_dm,
	26	horzcat_sm, horzcat_im, horzcat_rm; END INTERFACE cat
[4120]	27	INTERFACE find; MODULE PROCEDURE strFind, find_int, find_boo; END INTERFACE find
[4046]	28	INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
	29	INTERFACE reduceExpr; MODULE PROCEDURE reduceExpr_1, reduceExpr_m; END INTERFACE reduceExpr
	30	INTERFACE addQuotes; MODULE PROCEDURE addQuotes_1, addQuotes_m; END INTERFACE addQuotes
	31	INTERFACE testFile; MODULE PROCEDURE testFile_1, testFile_m; END INTERFACE testFile
	32
	33	INTEGER, PARAMETER :: maxlen = 256 !--- Standard maximum length for strings
	34	INTEGER, SAVE :: lunout = 6 !--- Printing unit (default: 6, ie. on screen)
	35	INTEGER, SAVE :: prt_level = 1 !--- Printing level (default: 1, ie. print all)
	36
	37	CONTAINS
	38
[4349]	39	!==============================================================================================================================
[4046]	40	LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
	41	LOGICAL, INTENT(IN) :: lcond
	42	LOGICAL, INTENT(OUT) :: lout
	43	lerr = lcond; lout = lcond
	44	END FUNCTION test
[4349]	45	!==============================================================================================================================
[4046]	46
[4349]	47
[4046]	48	!==============================================================================================================================
	49	SUBROUTINE init_printout(lunout_, prt_level_)
	50	INTEGER, INTENT(IN) :: lunout_, prt_level_
[4363]	51	lunout = lunout_
	52	prt_level = prt_level_
[4046]	53	END SUBROUTINE init_printout
	54	!==============================================================================================================================
	55
	56
	57	!==============================================================================================================================
	58	!=== Same as getin ; additional last argument: the default value.
	59	!==============================================================================================================================
	60	SUBROUTINE getin_s(nam, val, def)
	61	USE ioipsl_getincom, ONLY: getin
	62	CHARACTER(LEN=*), INTENT(IN) :: nam
	63	CHARACTER(LEN=*), INTENT(INOUT) :: val
	64	CHARACTER(LEN=*), INTENT(IN) :: def
	65	val = def; CALL getin(nam, val)
	66	IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(val)
	67	END SUBROUTINE getin_s
	68	!==============================================================================================================================
	69	SUBROUTINE getin_i(nam, val, def)
	70	USE ioipsl_getincom, ONLY: getin
	71	CHARACTER(LEN=*), INTENT(IN) :: nam
	72	INTEGER, INTENT(INOUT) :: val
	73	INTEGER, INTENT(IN) :: def
	74	val = def; CALL getin(nam, val)
	75	IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
	76	END SUBROUTINE getin_i
	77	!==============================================================================================================================
	78	SUBROUTINE getin_r(nam, val, def)
	79	USE ioipsl_getincom, ONLY: getin
	80	CHARACTER(LEN=*), INTENT(IN) :: nam
	81	REAL, INTENT(INOUT) :: val
	82	REAL, INTENT(IN) :: def
	83	val = def; CALL getin(nam, val)
	84	IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
	85	END SUBROUTINE getin_r
	86	!==============================================================================================================================
	87	SUBROUTINE getin_l(nam, val, def)
	88	USE ioipsl_getincom, ONLY: getin
	89	CHARACTER(LEN=*), INTENT(IN) :: nam
	90	LOGICAL, INTENT(INOUT) :: val
	91	LOGICAL, INTENT(IN) :: def
	92	val = def; CALL getin(nam, val)
[4047]	93	IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
[4046]	94	END SUBROUTINE getin_l
	95	!==============================================================================================================================
	96
	97
	98	!==============================================================================================================================
	99	!=== Display one or several messages, one each line, starting with the current routine name "modname".
	100	!==============================================================================================================================
	101	SUBROUTINE msg_1(str, modname, ll, unit)
	102	!--- Display a simple message "str". Optional parameters:
	103	! * "modname": module name, displayed in front of the message (with ": " separator) if present.
	104	! * "ll": message trigger ; message is displayed only if ll==.TRUE.
	105	! * "unit": write unit (by default: "lunout")
	106	CHARACTER(LEN=*), INTENT(IN) :: str
	107	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	108	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	109	INTEGER, OPTIONAL, INTENT(IN) :: unit
[4349]	110	!------------------------------------------------------------------------------------------------------------------------------
[4120]	111	CHARACTER(LEN=maxlen) :: subn
[4046]	112	INTEGER :: unt
[4120]	113	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	114	IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
[4046]	115	unt = lunout; IF(PRESENT(unit)) unt = unit
[4120]	116	IF(subn == '') WRITE(unt,'(a)') str !--- Simple message
	117	IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str !--- Routine name provided
[4046]	118	END SUBROUTINE msg_1
	119	!==============================================================================================================================
	120	SUBROUTINE msg_m(str, modname, ll, unit, nmax)
	121	!--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
	122	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	123	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	124	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	125	INTEGER, OPTIONAL, INTENT(IN) :: unit
	126	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	127	!------------------------------------------------------------------------------------------------------------------------------
[4046]	128	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
[4120]	129	CHARACTER(LEN=maxlen) :: subn
[4046]	130	INTEGER :: unt, nmx, k
[4063]	131	LOGICAL :: l
[4120]	132	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	133	l = .TRUE.; IF(PRESENT(ll)) l = ll
	134	unt = lunout; IF(PRESENT(unit)) unt = unit
	135	nmx = 128; IF(PRESENT(nmax)) nmx = nmax
[4046]	136	s = strStackm(str, ', ', nmx)
[4120]	137	DO k=1,SIZE(s); CALL msg_1(s(k), subn, l, unt); END DO
[4046]	138	END SUBROUTINE msg_m
	139	!==============================================================================================================================
[4063]	140	LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
[4046]	141	CHARACTER(LEN=*), INTENT(IN) :: str
	142	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	143	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	144	INTEGER, OPTIONAL, INTENT(IN) :: unit
[4349]	145	!------------------------------------------------------------------------------------------------------------------------------
[4120]	146	CHARACTER(LEN=maxlen) :: subn
[4046]	147	INTEGER :: unt
[4120]	148	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	149	l = .TRUE.; IF(PRESENT(ll)) l = ll
	150	unt = lunout; IF(PRESENT(unit)) unt = unit
[4120]	151	CALL msg_1(str, subn, l, unt)
[4046]	152	END FUNCTION fmsg_1
	153	!==============================================================================================================================
[4063]	154	LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
[4046]	155	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	156	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
	157	LOGICAL, OPTIONAL, INTENT(IN) :: ll
	158	INTEGER, OPTIONAL, INTENT(IN) :: unit
	159	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	160	!------------------------------------------------------------------------------------------------------------------------------
[4120]	161	CHARACTER(LEN=maxlen) :: subn
[4046]	162	INTEGER :: unt, nmx
[4120]	163	subn = ''; IF(PRESENT(modname)) subn = modname
[4063]	164	l = .TRUE.; IF(PRESENT(ll)) l = ll
	165	unt = lunout; IF(PRESENT(unit)) unt = unit
	166	nmx = 128; IF(PRESENT(nmax)) nmx = nmax
[4120]	167	CALL msg_m(str, subn, l, unt, nmx)
[4046]	168	END FUNCTION fmsg_m
	169	!==============================================================================================================================
	170
	171
	172	!==============================================================================================================================
	173	!=== Lower/upper case conversion function. ====================================================================================
	174	!==============================================================================================================================
	175	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
	176	CHARACTER(LEN=*), INTENT(IN) :: str
	177	INTEGER :: k
	178	out = str
	179	DO k=1,LEN_TRIM(str)
[4120]	180	IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
[4046]	181	END DO
	182	END FUNCTION strLower
	183	!==============================================================================================================================
	184	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
	185	CHARACTER(LEN=*), INTENT(IN) :: str
	186	INTEGER :: k
	187	out = str
	188	DO k=1,LEN_TRIM(str)
[4120]	189	IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
[4046]	190	END DO
	191	END FUNCTION strUpper
	192	!==============================================================================================================================
	193
	194
	195	!==============================================================================================================================
	196	!=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================
	197	!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================
	198	!=== * strHead(..,.FALSE.) = 'a' ${str%%$sep*} ================
	199	!=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================
	200	!==============================================================================================================================
	201	CHARACTER(LEN=maxlen) FUNCTION strHead_1(str,sep,lFirst) RESULT(out)
	202	CHARACTER(LEN=*), INTENT(IN) :: str
	203	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	204	LOGICAL, OPTIONAL, INTENT(IN) :: lFirst
[4349]	205	!------------------------------------------------------------------------------------------------------------------------------
[4046]	206	LOGICAL :: lf
	207	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
	208	IF(PRESENT(sep)) THEN
	209	out = str(1:INDEX(str,sep,.NOT.lf)-1)
	210	ELSE
	211	out = str(1:INDEX(str,'/',.NOT.lf)-1)
	212	END IF
	213	IF(out == '') out = str
	214	END FUNCTION strHead_1
	215	!==============================================================================================================================
	216	FUNCTION strHead_m(str,sep,lFirst) RESULT(out)
	217	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	218	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	219	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	220	LOGICAL, OPTIONAL, INTENT(IN) :: lFirst
[4349]	221	!------------------------------------------------------------------------------------------------------------------------------
[4046]	222	LOGICAL :: lf
	223	INTEGER :: k
	224	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
	225	IF(PRESENT(sep)) THEN
[4120]	226	out = [(strHead_1(str(k), sep, lf), k=1, SIZE(str))]
[4046]	227	ELSE
[4120]	228	out = [(strHead_1(str(k), lFirst=lf), k=1, SIZE(str))]
[4046]	229	END IF
	230	END FUNCTION strHead_m
	231	!==============================================================================================================================
	232	!=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================
	233	!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================
[4120]	234	!=== * strTail(..,.FALSE.) = 'c' ${str#*$sep} ================
	235	!=== * strTail(..,.TRUE.) = 'b_c' ${str##*$sep} ================
[4046]	236	!==============================================================================================================================
	237	CHARACTER(LEN=maxlen) FUNCTION strTail_1(str,sep,lFirst) RESULT(out)
	238	CHARACTER(LEN=*), INTENT(IN) :: str
	239	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	240	LOGICAL, OPTIONAL, INTENT(IN) :: lFirst
[4349]	241	!------------------------------------------------------------------------------------------------------------------------------
[4046]	242	LOGICAL :: lf
	243	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
	244	IF(PRESENT(sep)) THEN
	245	out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str))
	246	ELSE
	247	out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str))
	248	END IF
	249	IF(out == '') out = str
	250	END FUNCTION strTail_1
	251	!==============================================================================================================================
	252	FUNCTION strTail_m(str,sep,lFirst) RESULT(out)
	253	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	254	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	255	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	256	LOGICAL, OPTIONAL, INTENT(IN) :: lFirst
[4349]	257	!------------------------------------------------------------------------------------------------------------------------------
[4046]	258	LOGICAL :: lf
	259	INTEGER :: k
	260	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
	261	IF(PRESENT(sep)) THEN
[4120]	262	out = [(strTail_1(str(k), sep, lf), k=1, SIZE(str))]
[4046]	263	ELSE
[4120]	264	out = [(strTail_1(str(k), lFirst=lf), k=1, SIZE(str))]
[4046]	265	END IF
	266	END FUNCTION strTail_m
	267	!==============================================================================================================================
	268
	269
	270	!==============================================================================================================================
	271	!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
	272	!==============================================================================================================================
[4063]	273	FUNCTION strStack(str, sep, mask) RESULT(out)
[4046]	274	CHARACTER(LEN=:), ALLOCATABLE :: out
	275	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	276	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
[4063]	277	LOGICAL, OPTIONAL, INTENT(IN) :: mask(:)
[4349]	278	!------------------------------------------------------------------------------------------------------------------------------
[4046]	279	CHARACTER(LEN=:), ALLOCATABLE :: s
[4063]	280	INTEGER :: is, i0
[4046]	281	IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
	282	ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
[4063]	283	IF(PRESENT(mask)) THEN
	284	IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF
	285	i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO
	286	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
	287	ELSE
	288	out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
	289	END IF
[4046]	290	END FUNCTION strStack
	291	!==============================================================================================================================
	292	!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
	293	!==============================================================================================================================
	294	FUNCTION strStackm(str, sep, nmax) RESULT(out)
	295	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	296	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	297	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
	298	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	299	!------------------------------------------------------------------------------------------------------------------------------
[4046]	300	CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
	301	CHARACTER(LEN=maxlen) :: sp
	302	INTEGER :: is, ns, no, mx, n
	303	IF(SIZE(str) == 0) THEN; out = ['']; RETURN; END IF
	304	sp =', '; IF(PRESENT(sep )) sp = sep
	305	ns = 2 ; IF(PRESENT(sep )) ns = LEN(sep)
	306	mx = 256; IF(PRESENT(nmax)) mx = nmax
	307	no = 1; out = ['']
	308	DO is = 1, SIZE(str)
	309	n = LEN_TRIM(str(is)); IF(out(no)/='') n = n+ns+LEN_TRIM(out(no)) !--- Line length after "str(is)" inclusion
	310	IF(out(no) == '') THEN
	311	out(no) = str(is) !--- Empty new line: set to "str(is)"
	312	ELSE IF(n <= mx) THEN
	313	out(no) = TRIM(out(no))//sp(1:ns)//TRIM(str(is)) !--- Append "str(is)" to the current line
	314	ELSE
	315	ALLOCATE(t(no+1)); t(1:no) = out; no=no+1; t(no) = str(is) !--- Full line: "str(si)" put in next line
	316	CALL MOVE_ALLOC(FROM=t, TO=out)
	317	END IF
	318	END DO
	319	END FUNCTION strStackm
	320	!==============================================================================================================================
	321
	322
	323	!==============================================================================================================================
	324	!=== String cleaning: replace tabulation by spaces, remove NULL characters and comments. ======================================
	325	!==============================================================================================================================
	326	SUBROUTINE strClean_1(str)
	327	CHARACTER(LEN=*), INTENT(INOUT) :: str
	328	INTEGER :: k, n, m
	329	n = LEN(str)
	330	DO k = n, 1, -1
	331	m = IACHAR(str(k:k))
	332	IF(m==9) str(k:k) = ' ' !--- Replace the tabulations with spaces
	333	IF(m==0) str(k:n) = str(k+1:n)//' ' !--- Remove the NULL characters
	334	END DO
	335	m = INDEX(str,'!')-1; IF(m==-1) m = LEN_TRIM(str) !--- Remove end of line comment
	336	str = ADJUSTL(str(1:m))
	337	END SUBROUTINE strClean_1
	338	!==============================================================================================================================
	339	SUBROUTINE strClean_m(str)
	340	CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
	341	INTEGER :: k
	342	DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
	343	END SUBROUTINE strClean_m
	344	!==============================================================================================================================
	345
	346
	347	!==============================================================================================================================
	348	!=== strReduce_1(str1) : Remove duplicated elements of str1. ===========================================================
	349	!=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
	350	!==============================================================================================================================
[4067]	351	SUBROUTINE strReduce_1(str, nb)
	352	CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
[4046]	353	INTEGER, OPTIONAL, INTENT(OUT) :: nb
[4349]	354	!------------------------------------------------------------------------------------------------------------------------------
[4046]	355	CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
[4068]	356	INTEGER :: k, n, n1
	357	IF(PRESENT(nb)) nb = 0
	358	CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
	359	n1 = SIZE(s1, DIM=1) !--- Total nb. of elements in "s1"
	360	n = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] ) !--- Nb of unique elements in "s1"
	361	ALLOCATE(str(n))
	362	IF(n==0) RETURN
	363	str(1) = s1(1)
[4069]	364	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]	365	IF(PRESENT(nb)) nb=n
[4046]	366	END SUBROUTINE strReduce_1
	367	!==============================================================================================================================
	368	SUBROUTINE strReduce_2(str1, str2)
	369	CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str1(:)
	370	CHARACTER(LEN=*), INTENT(IN) :: str2(:)
[4349]	371	!------------------------------------------------------------------------------------------------------------------------------
[4046]	372	CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
	373	INTEGER :: k
	374	IF(SIZE(str2)==0) RETURN
	375	s2 = str2; CALL strClean(s2)
	376	IF(.NOT.ALLOCATED(s2)) RETURN
	377	IF(SIZE(s2) == 0) THEN; DEALLOCATE(s2); RETURN; END IF
	378	IF(.NOT.ALLOCATED(str1)) THEN
	379	str1 = s2
	380	ELSE IF(SIZE(str1)==0) THEN
	381	str1 = s2
	382	ELSE
	383	s1 = str1; CALL strClean(s1)
	384	str1 = [s1, PACK(s2, MASK= [( ALL(s1(:) /= s2(k)), k=1, SIZE(s2) )] ) ]
	385	END IF
	386	END SUBROUTINE strReduce_2
	387	!==============================================================================================================================
	388
	389
	390	!==============================================================================================================================
[4349]	391	!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
	392	!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0 ============================
[4046]	393	!==============================================================================================================================
	394	INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
	395	CHARACTER(LEN=*), INTENT(IN) :: str(:), s
	396	DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
	397	IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
	398	END FUNCTION strIdx_1
	399	!==============================================================================================================================
	400	FUNCTION strIdx_m(str, s, n) RESULT(out)
	401	CHARACTER(LEN=*), INTENT(IN) :: str(:), s(:)
	402	INTEGER, OPTIONAL, INTENT(OUT) :: n
	403	INTEGER, ALLOCATABLE :: out(:)
[4349]	404	!------------------------------------------------------------------------------------------------------------------------------
[4046]	405	INTEGER :: k
	406	out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
	407	IF(PRESENT(n)) n = COUNT(out(:)/=0)
	408	END FUNCTION strIdx_m
	409	!==============================================================================================================================
	410
	411
	412	!==============================================================================================================================
	413	!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
	414	!==============================================================================================================================
	415	FUNCTION strFind(str, s, n) RESULT(out)
	416	CHARACTER(LEN=*), INTENT(IN) :: str(:), s
	417	INTEGER, OPTIONAL, INTENT(OUT) :: n
	418	INTEGER, ALLOCATABLE :: out(:)
[4349]	419	!------------------------------------------------------------------------------------------------------------------------------
[4046]	420	INTEGER :: k
	421	out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
	422	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
	423	END FUNCTION strFind
	424	!==============================================================================================================================
	425	FUNCTION find_int(i,j,n) RESULT(out)
	426	INTEGER, INTENT(IN) :: i(:), j
	427	INTEGER, OPTIONAL, INTENT(OUT) :: n
	428	INTEGER, ALLOCATABLE :: out(:)
[4349]	429	!------------------------------------------------------------------------------------------------------------------------------
[4046]	430	INTEGER :: k
	431	out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
	432	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
	433	END FUNCTION find_int
	434	!==============================================================================================================================
	435	FUNCTION find_boo(l,n) RESULT(out)
	436	LOGICAL, INTENT(IN) :: l(:)
	437	INTEGER, OPTIONAL, INTENT(OUT) :: n
	438	INTEGER, ALLOCATABLE :: out(:)
[4349]	439	!------------------------------------------------------------------------------------------------------------------------------
[4046]	440	INTEGER :: k
	441	out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
	442	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
	443	END FUNCTION find_boo
	444	!==============================================================================================================================
	445
	446
	447	!==============================================================================================================================
	448	!=== GET THE INDEX IN "rawList" OF THE 1ST APPEARANCE OF ONE OF THE "del(:)" SEPARATORS (0 IF NONE OF THEM ARE PRESENT)
	449	!=== IF lSc == .TRUE.: * SKIP HEAD SIGNS OR EXPONENTS SIGNS THAT SHOULD NOT BE CONFUSED WITH SEPARATORS
	450	!=== * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
	451	!==============================================================================================================================
	452	LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
	453	CHARACTER(LEN=*), INTENT(IN) :: rawList !--- String in which delimiters have to be identified
	454	CHARACTER(LEN=*), INTENT(IN) :: del(:) !--- List of delimiters
	455	INTEGER, INTENT(IN) :: ibeg !--- Start index
	456	INTEGER, INTENT(OUT) :: idx !--- Index of the first identified delimiter in "rawList"
	457	INTEGER, INTENT(OUT) :: idel !--- Index of the identified delimiter (0 if idx==0)
	458	LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation
[4348]	459	!------------------------------------------------------------------------------------------------------------------------------
[4363]	460	INTEGER :: idx0 !--- Used to display an identified non-numeric string
[4046]	461	lerr = .FALSE.
[4348]	462	idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList"
[4046]	463	IF(.NOT.PRESENT(lSc)) RETURN !--- No need to check exceptions for numbers => finished
	464	IF(.NOT. lSc ) RETURN !--- No need to check exceptions for numbers => finished
[4348]	465
	466	!=== No delimiter found: the whole string must be a valid number
	467	IF(idx == 0) THEN !--- No element of "del" in "rawList"
[4349]	468	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- String must be a number
[4348]	469	IF(lerr) idx = LEN_TRIM(rawList); RETURN !--- Set idx so that rawList(ibeg:idx-1) = whole string
[4046]	470	END IF
[4348]	471
	472	IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN !--- The front delimiter is different from +/-: error
	473	IF( idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string head is a valid number
	474
	475	!=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
	476	idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel) !--- Keep start index because idx is recycled
[4046]	477	IF(idx == 0) THEN
[4349]	478	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- No other delimiter: whole string must be a valid numb
[4046]	479	IF(lerr) idx = idx0; RETURN
	480	END IF
[4349]	481	lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
[4348]	482
[4046]	483	CONTAINS
	484
[4348]	485	!------------------------------------------------------------------------------------------------------------------------------
[4349]	486	INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
[4348]	487	!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
	488	!--- "id" is the index in "del(:)" of the first delimiter found.
[4349]	489	IMPLICIT NONE
[4348]	490	CHARACTER(LEN=*), INTENT(IN) :: str, del(:)
[4046]	491	INTEGER, INTENT(IN) :: ib
	492	INTEGER, INTENT(OUT) :: id
[4348]	493	!------------------------------------------------------------------------------------------------------------------------------
[4349]	494	DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
	495	IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
[4046]	496	END FUNCTION strIdx1
	497
	498	END FUNCTION strIdx_prv
	499	!==============================================================================================================================
	500
	501
	502	!==============================================================================================================================
	503	!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
	504	!==============================================================================================================================
[4358]	505	LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
[4046]	506	CHARACTER(LEN=*), INTENT(IN) :: rawList
	507	CHARACTER(LEN=*), INTENT(IN) :: delimiter
	508	INTEGER, INTENT(OUT) :: nb
	509	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	510	!------------------------------------------------------------------------------------------------------------------------------
[4046]	511	LOGICAL :: ll
	512	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
[4358]	513	lerr = strCount_1m(rawList, [delimiter], nb, ll)
[4046]	514	END FUNCTION strCount_11
	515	!==============================================================================================================================
[4358]	516	LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
[4046]	517	CHARACTER(LEN=*), INTENT(IN) :: rawList(:)
	518	CHARACTER(LEN=*), INTENT(IN) :: delimiter
	519	INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
	520	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	521	!------------------------------------------------------------------------------------------------------------------------------
[4046]	522	LOGICAL :: ll
	523	INTEGER :: id
	524	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
[4358]	525	lerr = .TRUE.
[4046]	526	ALLOCATE(nb(SIZE(rawList)))
	527	DO id = 1, SIZE(rawList)
[4358]	528	lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
[4046]	529	END DO
	530	END FUNCTION strCount_m1
	531	!==============================================================================================================================
	532	LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
	533	CHARACTER(LEN=*), INTENT(IN) :: rawList
	534	CHARACTER(LEN=*), INTENT(IN) :: delimiter(:)
	535	INTEGER, INTENT(OUT) :: nb
	536	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
[4349]	537	!------------------------------------------------------------------------------------------------------------------------------
[4046]	538	INTEGER :: ib, ie, jd, nr
	539	LOGICAL :: ll
	540	CHARACTER(LEN=1024) :: r
	541	lerr = .FALSE.
	542	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
	543	r = TRIM(ADJUSTL(rawList))
	544	nr = LEN_TRIM(r); IF(nr == 0) RETURN
	545	nb = 1; ib = 1
	546	DO
	547	lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
	548	IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
[4349]	549	IF(ie == 0 .OR. jd == 0) EXIT
[4046]	550	ib = ie + LEN(delimiter(jd))
	551	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
	552	nb = nb + 1
	553	END DO
	554	END FUNCTION strCount_1m
	555	!==============================================================================================================================
	556
	557
	558	!==============================================================================================================================
	559	!=== Purpose: Parse "delimiter"-separated list "rawList" into the pair keys(:), vals(:). ====================================
	560	!=== Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
	561	!==============================================================================================================================
[4348]	562	LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
[4046]	563	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter
	564	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
[4348]	565	INTEGER, OPTIONAL, INTENT(OUT) :: n
[4046]	566	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
[4348]	567	!------------------------------------------------------------------------------------------------------------------------------
	568	CHARACTER(LEN=1024) :: r
[4349]	569	INTEGER :: nr, nk
[4348]	570	lerr = .FALSE.
	571	r = TRIM(ADJUSTL(rawList))
	572	nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
	573	CALL strParse_prv(nk) !--- COUNT THE ELEMENTS
[4349]	574	ALLOCATE(keys(nk))
	575	IF(PRESENT(vals)) THEN
	576	ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals) !--- PARSE THE KEYS
	577	ELSE
	578	CALL strParse_prv(nk, keys) !--- PARSE THE KEYS
	579	END IF
[4348]	580	IF(PRESENT(n)) n = nk
	581
	582	CONTAINS
	583
[4349]	584	!------------------------------------------------------------------------------------------------------------------------------
	585	SUBROUTINE strParse_prv(nkeys, keys, vals)
	586	!--- * Get the number of elements after parsing ("nkeys" only is present)
[4348]	587	!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
[4349]	588	IMPLICIT NONE
	589	INTEGER, INTENT(OUT) :: nkeys
[4348]	590	CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
	591	CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
[4349]	592	!------------------------------------------------------------------------------------------------------------------------------
	593	INTEGER :: ib, ie
	594	nkeys = 1; ib = 1
[4348]	595	DO
	596	ie = INDEX(rawList(ib:nr), delimiter)+ib-1 !--- Determine the next separator start index
	597	IF(ie == ib-1) EXIT
[4349]	598	IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1) !--- Get the ikth key
	599	IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys)) !--- Parse the ikth <key>=<val> pair
[4348]	600	ib = ie + LEN(delimiter)
	601	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
[4349]	602	nkeys = nkeys+1
[4348]	603	END DO
[4349]	604	IF(PRESENT(keys)) keys(nkeys) = r(ib:nr) !--- Get the last key
	605	IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys)) !--- Parse the last <key>=<val> pair
[4348]	606	END SUBROUTINE strParse_prv
	607
[4349]	608	!------------------------------------------------------------------------------------------------------------------------------
[4348]	609	SUBROUTINE parseKeys(key, val)
	610	CHARACTER(LEN=*), INTENT(INOUT) :: key
	611	CHARACTER(LEN=*), INTENT(OUT) :: val
[4349]	612	!------------------------------------------------------------------------------------------------------------------------------
[4348]	613	INTEGER :: ix
	614	ix = INDEX(key, '='); IF(ix == 0) RETURN !--- First "=" index in "key"
	615	val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
	616	key = ADJUSTL(key(1:ix-1))
	617	END SUBROUTINE parseKeys
	618
	619	END FUNCTION strParse
[4046]	620	!==============================================================================================================================
[4348]	621	LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
[4046]	622	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter(:)
	623	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:) !--- Parsed keys vector
[4348]	624	INTEGER, OPTIONAL, INTENT(OUT) :: n !--- Length of the parsed vector
	625	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:) !--- Values for <name>=<value> keys
[4046]	626	LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Take care about numbers in scientific notation
	627	INTEGER, OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:) !--- Indexes of the separators in "delimiter(:)" vector
[4348]	628	!------------------------------------------------------------------------------------------------------------------------------
[4046]	629	CHARACTER(LEN=1024) :: r
	630	INTEGER :: nr, ik, nk, ib, ie, jd
	631	LOGICAL :: ll
	632	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
	633	IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
	634
	635	!--- FEW ALLOCATIONS
	636	ALLOCATE(keys(nk))
	637	IF(PRESENT(vals)) ALLOCATE(vals(nk))
	638	IF(PRESENT(id)) ALLOCATE(id(nk-1))
	639	IF(PRESENT(n)) n = nk
	640
	641	!--- PARSING
	642	r = TRIM(ADJUSTL(rawList))
	643	nr = LEN_TRIM(r); IF(nr == 0) RETURN
	644	ib = 1
	645	DO ik = 1, nk-1
	646	IF(test(fmsg('Non-numeric values found', ll=strIdx_prv(r, delimiter, ib, ie, jd, ll)),lerr)) RETURN
	647	keys(ik) = r(ib:ie-1)
	648	IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik)) !--- Parse a <key>=<val> pair
	649	IF(PRESENT(id )) id(ik) = jd !--- Index in "delimiter(:)" of the "ik"th delimiter
	650	ib = ie + LEN_TRIM( delimiter(jd) ) !--- Length of the current delimiter
	651	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
	652	END DO
	653	keys(nk) = r(ib:nr)
	654	IF(PRESENT(vals)) CALL parseKeys(keys(nk), vals(nk)) !--- Parse a <key>=<val> pair
	655
	656	CONTAINS
	657
[4349]	658	!------------------------------------------------------------------------------------------------------------------------------
[4046]	659	SUBROUTINE parseKeys(key, val)
	660	CHARACTER(LEN=*), INTENT(INOUT) :: key
	661	CHARACTER(LEN=*), INTENT(OUT) :: val
[4349]	662	!------------------------------------------------------------------------------------------------------------------------------
[4046]	663	INTEGER :: ix
	664	ix = INDEX(key, '='); IF(ix == 0) RETURN !--- First "=" index in "key"
	665	val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
	666	key = ADJUSTL(key(1:ix-1))
	667	END SUBROUTINE parseKeys
	668
	669	END FUNCTION strParse_m
	670	!==============================================================================================================================
	671
	672
	673	!==============================================================================================================================
	674	!=== String substitution: replace "key" by "val" each time it appears in "str".
	675	!==============================================================================================================================
	676	SUBROUTINE strReplace_1(str, key, val, lsurr)
	677	CHARACTER(LEN=*), INTENT(INOUT) :: str !--- Main string
	678	CHARACTER(LEN=*), INTENT(IN) :: key, val !--- "key" will be replaced by "val"
	679	LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted
[4349]	680	!------------------------------------------------------------------------------------------------------------------------------
[4046]	681	INTEGER :: i0, ix, nk, ns
	682	LOGICAL :: lsur, lb, le
	683	lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
	684	nk = LEN_TRIM(key)
	685	i0 = 1
	686	DO
	687	ns = LEN_TRIM(str)
	688	ix = INDEX(str(i0:ns), TRIM(key)) !--- First appearance index of "key" in "s", starting from index "i0"
	689	IF(ix == 0) EXIT
	690	ix = ix + i0 -1
	691	IF(lsur) THEN !--- Key must be surrounded by special characters
	692	!--- lb=.TRUE.: key is at the very beginning of "str" or located after a special character
	693	lb = ix ==1; IF(.NOT.lb) lb = INDEX('+-*/()^', str(ix-1 :ix-1 ))/=0
	694	!--- le=.TRUE.: key is at the very end of "str" or located before a special character
	695	le = ix+nk-1==ns; IF(.NOT.le) le = INDEX('+-*/()^', str(ix+nk:ix+nk))/=0
	696	IF(.NOT.(lb.AND.le)) THEN; i0 = i0 + nk; CYCLE; END IF
	697	END IF
	698	str = str(1:ix-1)//TRIM(val)//str(ix+nk:ns)
	699	END DO
	700	END SUBROUTINE strReplace_1
	701	!==============================================================================================================================
	702	SUBROUTINE strReplace_m(str, key, val, lsurr)
	703	CHARACTER(LEN=*), INTENT(INOUT) :: str(:) !--- Main strings vector
	704	CHARACTER(LEN=*), INTENT(IN) :: key, val !--- "key" will be replaced by "val"
	705	LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted
	706	INTEGER :: k
	707	LOGICAL :: ll
	708	ll=.FALSE.; IF(PRESENT(lsurr)) ll=lsurr
	709	DO k=1, SIZE(str); CALL strReplace_1(str(k),key,val,ll); END DO
	710	END SUBROUTINE strReplace_m
	711	!==============================================================================================================================
	712
	713
	714	!==============================================================================================================================
	715	!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
	716	!==============================================================================================================================
	717	FUNCTION horzcat_s1(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
	718	CHARACTER(LEN=*), TARGET, INTENT(IN) :: s0
	719	CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
	720	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[4349]	721	!------------------------------------------------------------------------------------------------------------------------------
[4046]	722	CHARACTER(LEN=maxlen), POINTER :: s
	723	LOGICAL :: lv(10)
	724	INTEGER :: iv
	725	lv = [ .TRUE. , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
	726	PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
	727	ALLOCATE(out(COUNT(lv)))
	728	DO iv=1, COUNT(lv)
	729	SELECT CASE(iv)
	730	CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
	731	CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
	732	END SELECT
	733	out(iv) = s
	734	END DO
	735	END FUNCTION horzcat_s1
	736	!==============================================================================================================================
	737	FUNCTION horzcat_sm(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
	738	CHARACTER(LEN=*), TARGET, DIMENSION(:), INTENT(IN) :: s0
	739	CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
	740	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
[4349]	741	!------------------------------------------------------------------------------------------------------------------------------
[4046]	742	CHARACTER(LEN=maxlen), POINTER :: s(:)
	743	LOGICAL :: lv(10)
	744	INTEGER :: nrow, ncol, iv, n
	745	lv = [ .TRUE. , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
	746	PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
	747	nrow = SIZE(s0); ncol=COUNT(lv)
	748	ALLOCATE(out(nrow, ncol))
	749	DO iv=1, ncol
	750	SELECT CASE(iv)
	751	CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
	752	CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
	753	END SELECT
	754	n = SIZE(s, DIM=1)
	755	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
	756	out(:,iv) = s(:)
	757	END DO
	758	END FUNCTION horzcat_sm
	759	!==============================================================================================================================
	760	FUNCTION horzcat_i1(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
	761	INTEGER, TARGET, INTENT(IN) :: i0
	762	INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
	763	INTEGER, ALLOCATABLE :: out(:)
[4349]	764	!------------------------------------------------------------------------------------------------------------------------------
[4046]	765	INTEGER, POINTER :: i
	766	LOGICAL :: lv(10)
	767	INTEGER :: iv
	768	lv = [ .TRUE. , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
	769	PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
	770	ALLOCATE(out(COUNT(lv)))
	771	DO iv=1, COUNT(lv)
	772	SELECT CASE(iv)
	773	CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
	774	CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
	775	END SELECT
	776	out(iv) = i
	777	END DO
	778	END FUNCTION horzcat_i1
	779	!==============================================================================================================================
	780	FUNCTION horzcat_im(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
	781	INTEGER, TARGET, DIMENSION(:), INTENT(IN) :: i0
	782	INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
	783	INTEGER, ALLOCATABLE :: out(:,:)
[4349]	784	!------------------------------------------------------------------------------------------------------------------------------
[4046]	785	INTEGER, POINTER :: i(:)
	786	LOGICAL :: lv(10)
	787	INTEGER :: nrow, ncol, iv, n
	788	lv = [ .TRUE. , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
	789	PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
	790	nrow = SIZE(i0); ncol=COUNT(lv)
	791	ALLOCATE(out(nrow, ncol))
	792	DO iv=1, ncol
	793	SELECT CASE(iv)
	794	CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
	795	CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
	796	END SELECT
	797	n = SIZE(i, DIM=1)
	798	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
	799	out(:,iv) = i(:)
	800	END DO
	801	END FUNCTION horzcat_im
	802	!==============================================================================================================================
	803	FUNCTION horzcat_r1(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
	804	REAL, TARGET, INTENT(IN) :: r0
	805	REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
	806	REAL, ALLOCATABLE :: out(:)
[4349]	807	!------------------------------------------------------------------------------------------------------------------------------
[4046]	808	REAL, POINTER :: r
	809	LOGICAL :: lv(10)
	810	INTEGER :: iv
	811	lv = [ .TRUE. , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
	812	PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
	813	ALLOCATE(out(COUNT(lv)))
	814	DO iv=1, COUNT(lv)
	815	SELECT CASE(iv)
	816	CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
	817	CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
	818	END SELECT
	819	out(iv) = r
	820	END DO
	821	END FUNCTION horzcat_r1
	822	!==============================================================================================================================
	823	FUNCTION horzcat_rm(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
	824	REAL, TARGET, DIMENSION(:), INTENT(IN) :: r0
	825	REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
	826	REAL, ALLOCATABLE :: out(:,:)
[4349]	827	!------------------------------------------------------------------------------------------------------------------------------
[4046]	828	REAL, POINTER :: r(:)
	829	LOGICAL :: lv(10)
	830	INTEGER :: nrow, ncol, iv, n
	831	lv = [ .TRUE. , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
	832	PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
	833	nrow = SIZE(r0); ncol=COUNT(lv)
	834	ALLOCATE(out(nrow, ncol))
	835	DO iv=1, ncol
	836	SELECT CASE(iv)
	837	CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
	838	CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
	839	END SELECT
	840	n = SIZE(r, DIM=1)
	841	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
	842	out(:,iv) = r(:)
	843	END DO
	844	END FUNCTION horzcat_rm
	845	!==============================================================================================================================
	846	FUNCTION horzcat_d1(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
	847	DOUBLE PRECISION, TARGET, INTENT(IN) :: d0
	848	DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
	849	DOUBLE PRECISION, ALLOCATABLE :: out(:)
[4349]	850	!------------------------------------------------------------------------------------------------------------------------------
[4046]	851	DOUBLE PRECISION, POINTER :: d
	852	LOGICAL :: lv(10)
	853	INTEGER :: iv
	854	lv = [ .TRUE. , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
	855	PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
	856	ALLOCATE(out(COUNT(lv)))
	857	DO iv=1, COUNT(lv)
	858	SELECT CASE(iv)
	859	CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
	860	CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
	861	END SELECT
	862	out(iv) = d
	863	END DO
	864	END FUNCTION horzcat_d1
	865	!==============================================================================================================================
	866	FUNCTION horzcat_dm(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
	867	DOUBLE PRECISION, TARGET, DIMENSION(:), INTENT(IN) :: d0
	868	DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
	869	DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
[4349]	870	!------------------------------------------------------------------------------------------------------------------------------
[4046]	871	DOUBLE PRECISION, POINTER :: d(:)
	872	LOGICAL :: lv(10)
	873	INTEGER :: nrow, ncol, iv, n
	874	lv = [ .TRUE. , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
	875	PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
	876	nrow = SIZE(d0); ncol=COUNT(lv)
	877	ALLOCATE(out(nrow, ncol))
	878	DO iv=1, ncol
	879	SELECT CASE(iv)
	880	CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
	881	CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
	882	END SELECT
	883	n = SIZE(d, DIM=1)
	884	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
	885	out(:,iv) = d(:)
	886	END DO
	887	END FUNCTION horzcat_dm
	888	!==============================================================================================================================
	889
	890
	891	!==============================================================================================================================
	892	!--- Display a clean table composed of successive vectors of same length.
	893	!=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display.
[4193]	894	!=== * nRowMax lines are displayed (default: all lines)
	895	!=== * nColMax characters (default: as long as needed) are displayed at most on a line. If the effective total length is
	896	!=== higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table.
[4046]	897	!==============================================================================================================================
[4193]	898	LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
[4046]	899	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	900	CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (ONE EACH COLUMN)
	901	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	902	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	903	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	904	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
[4193]	905	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows
	906	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line
	907	INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display
[4046]	908	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen)
[4120]	909	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
[4349]	910	!------------------------------------------------------------------------------------------------------------------------------
[4046]	911	CHARACTER(LEN=2048) :: row
[4120]	912	CHARACTER(LEN=maxlen) :: rFm, el, subn
[4046]	913	CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
	914	CHARACTER(LEN=1) :: s1, sp
[4193]	915	INTEGER :: is, ii, ir, it, k, nmx, unt, ic, np
	916	INTEGER :: ns, ni, nr, nt, l, ncol, nHd, ib, l0
	917	INTEGER, ALLOCATABLE :: n(:), ncmx(:)
	918	INTEGER, PARAMETER :: nm=1 !--- Space between values & columns
[4046]	919	LOGICAL :: ls, li, lr
[4120]	920	subn = ''; IF(PRESENT(sub)) subn = sub
[4046]	921	rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals
	922	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Specified output unit
	923	np = LEN_TRIM(p); ns = 0; ni = 0; nr = 0; ncol = 0
	924	ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
	925	lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN !--- Nothing to do
	926	sp = '\|' !--- Separator
	927
	928	!--- CHECK ARGUMENTS COHERENCE
[4193]	929	lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
[4120]	930	IF(ls) THEN
	931	ns = SIZE(s, 1); ncol = ncol + SIZE(s, 2); lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, 2)
[4046]	932	END IF
[4120]	933	IF(li) THEN
	934	ni = SIZE(i, 1); ncol = ncol + SIZE(i, 2); lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, 2)
[4046]	935	END IF
[4120]	936	IF(lr) THEN
	937	nr = SIZE(r, 1); ncol = ncol + SIZE(r, 2); lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, 2)
[4046]	938	END IF
[4193]	939	IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
[4120]	940	lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', subn, lerr)) RETURN
	941	lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', subn, lerr)) RETURN
	942	lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg( 'string and real arguments lengths mismatch', subn, lerr)) RETURN
	943	lerr = li.AND.lr.AND.ni/=nr; IF(fmsg( 'integer and real arguments lengths mismatch', subn, lerr)) RETURN
[4193]	944	nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
[4046]	945
	946	!--- Allocate the assembled quantities array
[4193]	947	ALLOCATE(d(nmx,ncol), n(ncol))
[4046]	948
	949	!--- Assemble the vectors into a strings array in the order indicated by "pattern"
	950	is = 1; ii = 1; ir = 1
	951	DO ic = 1, ncol
	952	d(1,ic) = TRIM(titles(ic))
	953	SELECT CASE(p(ic:ic))
	954	CASE('s'); d(2:nmx,ic) = s(:,is) ; is = is + 1
	955	CASE('i'); d(2:nmx,ic) = int2str(i(:,ii) ); ii = ii + 1
	956	CASE('r'); d(2:nmx,ic) = real2str(r(:,ir),rFm); ir = ir + 1
	957	END SELECT
[4193]	958	END DO
	959	CALL cleanZeros(d)
	960	DO ic = 1, ncol
[4046]	961	n(ic)=0; DO ir=1, nmx; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
	962	END DO
	963	n(:) = n(:) + 2*nm
	964
[4193]	965	!--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts)
	966	nHd = 1; IF(PRESENT(nHead)) nHd = nHead
	967	IF(.NOT.PRESENT(nColMax)) THEN
	968	nt = 1; ncmx = [ncol]
	969	ELSE
	970	nt = 1; l0 = SUM(n(1:nHd)+1)+1
	971	IF(PRESENT(sub)) l0=l0+LEN_TRIM(subn)+1
	972	!--- Count the number of table parts
	973	l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; nt = nt+1; l = l0+n(ic)+1; END IF; END DO
	974	!--- Get the index of the last column for each table part
	975	ALLOCATE(ncmx(nt)); k = 1
	976	l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; ncmx(k) = ic-1; l = l0+n(ic)+1; k = k+1; END IF; END DO
	977	ncmx(nt) = ncol
	978	END IF
	979
[4046]	980	!--- Display the strings array as a table
[4193]	981	DO it = 1, nt
	982	DO ir = 1, nmx; row = ''
	983	DO ic = 1, nHd; el = d(ir,ic)
	984	s1 = sp
	985	row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
	986	END DO
	987	ib = nHd+1; IF(it>1) ib = ncmx(it-1)+1
	988	DO ic = ib, ncmx(it); el = d(ir,ic)
	989	s1 = sp
	990	row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
	991	END DO
	992	nr = LEN_TRIM(row)-1 !--- Final separator removed
	993	CALL msg(row(1:nr), subn, unit=unt)
[4349]	994	IF(ir /= 1) CYCLE !--- Titles only are underlined
[4193]	995	row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
	996	DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
	997	CALL msg(row(1:LEN_TRIM(row)-1), subn, unit=unt)
[4046]	998	END DO
[4193]	999	CALL msg('', subn, unit=unt)
[4046]	1000	END DO
	1001
	1002	END FUNCTION dispTable
	1003	!==============================================================================================================================
	1004
	1005	!==============================================================================================================================
	1006	LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
	1007	INTEGER, INTENT(IN) :: unt !--- Output unit
	1008	CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r
	1009	CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (ONE EACH COLUMN)
	1010	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS
	1011	INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS
	1012	REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS
	1013	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals
	1014	LOGICAL, OPTIONAL, INTENT(IN) :: llast !--- Last variable: no final ','
[4349]	1015	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1016	CHARACTER(LEN=maxlen) :: rFm, el
	1017	CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
	1018	CHARACTER(LEN=:), ALLOCATABLE :: sp, row
	1019	INTEGER :: is, ii, ir, nrow, ic
	1020	INTEGER :: ns, ni, nr, ncol, np
	1021	INTEGER, ALLOCATABLE :: n(:)
	1022	LOGICAL :: ls, li, lr, la
	1023	rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals
	1024	ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
	1025	lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN !--- Nothing to do
	1026	la = .FALSE.; IF(PRESENT(llast)) la = llast
	1027
	1028	!--- CHECK ARGUMENTS COHERENCE
	1029	ns = 0; ni = 0; nr = 0; np = LEN_TRIM(p); ncol = 0
	1030	IF(ls) THEN; ns = SIZE(s, DIM=1); ncol = ncol + SIZE(s, DIM=2)
	1031	lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, DIM=2)
	1032	END IF
	1033	IF(li) THEN; ni = SIZE(i, DIM=1); ncol = ncol + SIZE(i, DIM=2)
	1034	lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, DIM=2)
	1035	END IF
	1036	IF(lr) THEN; nr = SIZE(r, DIM=1); ncol = ncol + SIZE(r, DIM=2)
	1037	lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
	1038	END IF
[4193]	1039	IF(fmsg('display map "p" length and arguments number mismatch', ll=lerr)) RETURN
[4046]	1040	lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', ll=lerr)) RETURN
	1041	lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', ll=lerr)) RETURN
	1042	lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg( 'string and real arguments lengths mismatch', ll=lerr)) RETURN
	1043	lerr = li.AND.lr.AND.ni/=nr; IF(fmsg( 'integer and real arguments lengths mismatch', ll=lerr)) RETURN
	1044
	1045	!--- Allocate the assembled quantities array
	1046	nrow = MAX(ns,ni,nr)+1
	1047	ALLOCATE(d(nrow,ncol), n(ncol))
	1048
	1049	!--- Assemble the vectors into a strings array in the order indicated by "pattern"
	1050	is = 1; ii = 1; ir = 1
	1051	DO ic = 1, ncol
	1052	d(1,ic) = TRIM(titles(ic))
	1053	SELECT CASE(p(ic:ic))
	1054	CASE('s'); d(2:nrow,ic) = s(:,is) ; is = is + 1
	1055	CASE('i'); d(2:nrow,ic) = int2str(i(:,ii) ); ii = ii + 1
	1056	CASE('r'); d(2:nrow,ic) = real2str(r(:,ir),rFm); ir = ir + 1
	1057	END SELECT
[4193]	1058	END DO
	1059	CALL cleanZeros(d)
	1060	DO ic = 1, ncol
[4046]	1061	n(ic) = 0; DO ir=1, nrow; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
	1062	IF(needQuotes(d(2,ic)) .AND. ic/=1) n(ic) = n(ic) + 2 !--- For quotes, using second line only
	1063	END DO
	1064
	1065	!--- Display the strings array as a table
	1066	DO ir = 1, nrow
	1067	row = ''; sp = ' '; IF(TRIM(d(ir,1)) /= '') sp = ' = '
	1068	DO ic = 1, ncol
	1069	el = d(ir,ic); IF(ic /= 1) el = addQuotes_1(el)
	1070	row = row//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el))//sp
	1071	sp = ' '; IF(ic /= ncol-1) CYCLE
	1072	IF(TRIM(d(MIN(ir+1,nrow),1)) /= '' .AND. (ir /= nrow .OR. .NOT.la)) sp = ' , '
	1073	END DO
	1074	WRITE(unt,'(a)')TRIM(row)
	1075	END DO
	1076
	1077	!--- End of section
	1078	IF(la) THEN
	1079	WRITE(unt,'(a)')'/'
	1080	WRITE(unt,'(a)')
	1081	END IF
	1082
	1083	END FUNCTION dispNameList
	1084	!==============================================================================================================================
	1085
	1086
	1087	!==============================================================================================================================
[4193]	1088	LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
[4046]	1089	! Display outliers list in tables
	1090	! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
	1091	LOGICAL, INTENT(IN) :: ll(:) !--- Linearized mask of outliers
	1092	REAL, INTENT(IN) :: a(:) !--- Linearized array of values
	1093	INTEGER, INTENT(IN) :: n(:) !--- Profile before linearization
	1094	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: err_msg, nam(:), subn !--- Error message, variables and calling subroutine names
[4193]	1095	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of lines to display (default: all)
	1096	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters per line (default: 2048)
	1097	INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1)
	1098	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout)
[4349]	1099	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1100	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:)
	1101	LOGICAL, ALLOCATABLE :: m(:)
	1102	INTEGER, ALLOCATABLE :: ki(:), kj(:)
[4193]	1103	INTEGER :: i, j, k, rk, rk1, ib, ie, itr, nm, unt, nRmx, nCmx, nHd, nv
[4046]	1104	CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', v, s
	1105	CHARACTER(LEN=maxlen), ALLOCATABLE :: vnm(:)
	1106
	1107	lerr = ANY(ll); IF(.NOT.lerr) RETURN !--- No outliers -> finished
	1108
	1109	mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg !--- Error message
	1110	vnm = ['a']; IF(PRESENT(nam )) vnm = nam !--- Variables names
	1111	sub = 'dispOutliers'; IF(PRESENT(subn)) sub = subn !--- Calling subroutine name
[4193]	1112	nRmx= SIZE(a); IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
	1113	nCmx= 2048; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
	1114	nHd = 1; IF(PRESENT(nHead)) nHd = nHead !--- Number of front columns to duplicate
[4046]	1115	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages
	1116
	1117	rk = SIZE(n); nv = SIZE(vnm)
	1118	IF(test(fmsg('SIZE(nam) /= 1 and /= last "n" element', sub, nv /= 1 .AND. nv /= n(rk), unt),lerr)) RETURN
	1119	IF(test(fmsg('ll" and "a" sizes mismatch', sub, SIZE(a) /= SIZE(ll), unt),lerr)) RETURN
	1120	IF(test(fmsg('profile "n" does not match "a" and "ll', sub, SIZE(a) /= PRODUCT(n), unt),lerr)) RETURN
	1121	CALL msg(mes, sub, unit=unt)
	1122
	1123	!--- SCALAR CASE: single value to display
	1124	IF(rk==1.AND.n(1)==1) THEN
	1125	IF(ll(1)) WRITE(unt,'(a," = ",f12.9)')TRIM(nam(1)),a(1); RETURN
	1126	END IF
	1127
	1128	rk1 = rk; IF(nv==1) rk1 = rk-1 !--- Rank of each displayed table
	1129	SELECT CASE(rk1) !--- Indices list
	1130	CASE(1,2); ki = [ (i,i=1,n(1)) ]
	1131	CASE(3); ki = [((i,i=1,n(1)),j=1,n(2))]; kj = [((j,i=1,n(1)),j=1,n(2))]
	1132	CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers" is limited to rank 3'; RETURN
	1133	END SELECT
	1134
	1135	!--- VECTOR CASE: table " name \| value " (known names) / ) / " i \| a(i) " (unknown names)
	1136	IF(rk==1) THEN
	1137	ALLOCATE(ttl(2)); ttl(2) = TRIM(vnm(1))//'(i)'; ttl(1) = 'i'
[4193]	1138	IF(nv == 1) lerr = dispTable('sr', ttl, s=cat(PACK(nam,ll)), r=cat(PACK(a,ll)), &
	1139	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
	1140	IF(nv /= 1) lerr = dispTable('ir', ['name ','value'], i=cat(PACK(ki,m)), r=cat(PACK(a,ll)), &
	1141	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
[4046]	1142	CALL msg("can't display outliers table", sub, lerr, unt)
	1143	RETURN
	1144	END IF
	1145
	1146	!--- OTHER CASES: one table for each tracer (last index)
	1147	ttl = [(ACHAR(k), k = 105, 104+rk)] !--- Titles list ('i', 'j', 'k'...)
	1148	s = strStack( ttl(1:rk-1) ) !--- Tracer name dummy indexes: (i, j, k, ...
	1149
	1150	DO itr=1,n(rk)
	1151	nm = PRODUCT(n(1:rk-1)) !--- number of elements per tracer
	1152	ie = itr*nm; ib = ie-nm+1; m=ll(ib:ie) !--- section bounds for tracer "itr" ; outlayers mask
	1153	IF(.NOT.ANY(m)) CYCLE !--- no outlayers for tracer "itr"
	1154	v = TRIM(vnm(MIN(itr,SIZE(vnm))))//'('//TRIM(s) !--- "<name>("
	1155	IF(nv == 1) ttl(rk) = TRIM(v)//','//int2str(itr)//')' !--- "<name>(i,j,itr)" (single name)
	1156	IF(nv /= 1) ttl(rk) = TRIM(v)//')' !--- "<nam(itr)>(i,j)" (one name each table/itr index)
[4193]	1157	IF(rk==2) lerr = dispTable('ir', ttl, i=cat(PACK(ki,m)), r=cat(PACK(a(ib:ie),m)), &
	1158	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
	1159	IF(rk==3) lerr = dispTable('iir', ttl, i=cat(PACK(ki,m),PACK(kj,m)), r=cat(PACK(a(ib:ie),m)), &
	1160	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
[4046]	1161	CALL msg("can't display outliers table", sub, lerr, unt)
	1162	IF(lerr) RETURN
	1163	END DO
	1164	END FUNCTION dispOutliers_1
	1165	!==============================================================================================================================
[4193]	1166	LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
[4046]	1167	! Display outliers list in tables
	1168	! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
	1169	LOGICAL, INTENT(IN) :: ll(:) !--- Linearized mask of outliers
	1170	REAL, INTENT(IN) :: a(:,:) !--- Linearized arrays of values stacked along 2nd dim.
	1171	INTEGER, INTENT(IN) :: n(:) !--- Profile before linearization
	1172	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: err_msg, nam(:), subn !--- Error message, variables and calling subroutine names
[4193]	1173	INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of lines to display (default: all)
	1174	INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters per line (default: 2048)
	1175	INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1)
	1176	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout)
[4349]	1177	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1178	CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf
	1179	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), vnm(:)
	1180	INTEGER, ALLOCATABLE :: ki(:), kj(:), kl(:)
[4363]	1181	INTEGER :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
[4046]	1182	REAL, ALLOCATABLE :: val(:,:)
	1183
[4193]	1184	lerr = ANY(ll); IF(.NOT.lerr) RETURN !--- No outliers -> finished
[4046]	1185	rk = SIZE(n); nv = SIZE(a,2)
[4193]	1186	mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg !--- Error message
	1187	vnm = [(ACHAR(k+96),k=1,nv)]; IF(PRESENT(nam )) vnm = nam !--- Variables names
	1188	sub = 'dispOutliers'; IF(PRESENT(subn)) sub = subn !--- Calling subroutine name
	1189	nRmx= SIZE(a); IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
	1190	nCmx= 2048; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
	1191	nHd = 1; IF(PRESENT(nHead)) nHd = nHead !--- Number of front columns to duplicate
	1192	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages
	1193	lerr= SIZE(vnm) /= nv; IF(fmsg('SIZE(nam) /= SIZE(a,2)', sub, lerr, unt)) RETURN
	1194	lerr= SIZE(a,1) /= SIZE(ll); IF(fmsg('"ll" and "a" sizes mismatch', sub, lerr, unt)) RETURN
	1195	lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN
[4046]	1196
[4363]	1197	SELECT CASE(rk) !--- Indices list
[4046]	1198	CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF
	1199	CASE(1); ki = [ (i,i=1,n(1)) ]
	1200	CASE(2); ki = [ ((i,i=1,n(1)),j=1,n(2))]; kj = [ ((j,i=1,n(1)),j=1,n(2))]
	1201	CASE(3); ki = [(((i,i=1,n(1)),j=1,n(2)),k=1,n(3))]; kj = [(((j,i=1,n(1)),j=1,n(2)),k=1,n(3))]
	1202	kl = [(((k,i=1,n(1)),j=1,n(2)),k=1,n(3))]
	1203	CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers_2" is limited to rank 3'; RETURN
	1204	END SELECT
	1205
	1206	ttl = [(ACHAR(k), k = 105, 104+rk), vnm] !--- Titles list ('i', 'j', 'k'...'var1', 'var2', ...)
	1207	prf = REPEAT('i',rk)//REPEAT('r',nv) !--- Profile
	1208	ALLOCATE(val(COUNT(ll),nv)); DO k=1, nv; val(:,k) = PACK(a(:,k),ll); END DO
[4193]	1209	IF(rk == 1) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll)), r = val, &
	1210	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
	1211	IF(rk == 2) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll)), r = val, &
	1212	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
	1213	IF(rk == 3) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll),PACK(kl,ll)), r = val, &
	1214	rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
[4046]	1215	CALL msg("can't display outliers table", sub, lerr, unt)
	1216	END FUNCTION dispOutliers_2
	1217	!==============================================================================================================================
	1218
	1219
	1220	!==============================================================================================================================
	1221	!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
	1222	!==============================================================================================================================
	1223	LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
	1224	CHARACTER(LEN=*), INTENT(IN) :: str
	1225	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
[4349]	1226	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1227	CHARACTER(LEN=maxlen) :: v
	1228	CHARACTER(LEN=1024) :: s, vv
	1229	CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
	1230	INTEGER, ALLOCATABLE :: ip(:)
	1231	INTEGER :: nl, nn, i, j, im, ix
	1232	LOGICAL :: ll
	1233	s = str
	1234
	1235	!--- Check wether the parenthesis are correctly formed
	1236	ll = strCount(s,'(',nl)
	1237	ll = strCount(s,')',nn)
	1238	lerr = nl /= nn
	1239	IF(fmsg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr)) RETURN
	1240	nl = 2*nl-1
	1241
	1242	!--- Build vectors ; vl: parenthesis-separated elements ; ip: parenthesis types (1: opening, 2: closing)
	1243	ALLOCATE(ip(nl-1),vl(nl))
	1244	j = 1; im = 1
	1245	DO i = 1, LEN_TRIM(str)
	1246	ix = INDEX('()', str(i:i))
	1247	IF(ix == 0) CYCLE
	1248	ip(j) = ix
	1249	vl(j) = str(im:i-1)
	1250	j = j + 1; im = i + 1
	1251	END DO
	1252	vl(j) = str(im:LEN_TRIM(str))
	1253
	1254	!--- Search for each opening/closing parenthesis pair
	1255	DO WHILE(nl > 1)
	1256	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
	1257	IF(test(reduceExpr_basic(vl(i+1), v), lerr)) RETURN
	1258	v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
	1259	vv = v//REPEAT(' ',768)
	1260	IF(i == 1) THEN; ip = ip(3:nl-1); vl = [ vv, vl(4 :nl)]
	1261	ELSE IF(i == nl-1) THEN; ip = ip(1:nl-2); vl = [vl(1:nl-3), vv ]
	1262	ELSE; ip = [ip(1: i-1), ip(i+2:nl-1)]; vl = [vl(1: i-1), vv, vl(i+3:nl)]; END IF
	1263	nl = SIZE(vl)
	1264	END DO
	1265	lerr = reduceExpr_basic(vl(1), val)
	1266	END FUNCTION reduceExpr_1
	1267
	1268
	1269	!==============================================================================================================================
	1270	!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
	1271	!==============================================================================================================================
	1272	LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
	1273	CHARACTER(LEN=*), INTENT(IN) :: str
	1274	CHARACTER(LEN=*), INTENT(OUT) :: val
	1275	DOUBLE PRECISION, ALLOCATABLE :: vl(:)
	1276	INTEGER, ALLOCATABLE :: id(:)
	1277	CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
	1278	CHARACTER(LEN=1), ALLOCATABLE :: op(:)
[4349]	1279	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1280	CHARACTER(LEN=1024) :: s
	1281	DOUBLE PRECISION :: v, vm, vp
	1282	INTEGER :: i, ni, io
	1283	lerr = .FALSE.
	1284	IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
	1285	op = ['^','/','*','+','-'] !--- List of recognized operations
	1286	s = str
[4348]	1287	IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN !--- Parse the values
[4046]	1288	vl = str2dble(ky) !--- Conversion to doubles
	1289	lerr = ANY(vl >= HUGE(1.d0))
	1290	IF(fmsg('Some values are non-numeric in: '//TRIM(s), ll=lerr)) RETURN !--- Non-numerical values found
	1291	DO io = 1, SIZE(op) !--- Loop on known operators (order matters !)
	1292	DO i = SIZE(id), 1, -1 !--- Loop on found operators
	1293	ni = SIZE(id)
	1294	IF(id(i) /= io) CYCLE !--- Current found operator is not op(io)
	1295	vm = vl(i); vp = vl(i+1) !--- Couple of values used for current operation
[4349]	1296	SELECT CASE(op(io)) !--- Perform operation on the two values
	1297	CASE('^'); v = vm**vp
	1298	CASE('/'); v = vm/vp
	1299	CASE(''); v = vmvp
	1300	CASE('+'); v = vm+vp
	1301	CASE('-'); v = vm-vp
[4046]	1302	END SELECT
	1303	IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
	1304	IF(i == ni) THEN; id = id(1:ni-1); ELSE; id = [id(1:i-1), id(i+1:ni )]; END IF
	1305	END DO
	1306	END DO
	1307	val = dble2str(vl(1))
	1308
	1309	END FUNCTION reduceExpr_basic
	1310	!==============================================================================================================================
	1311
	1312	!==============================================================================================================================
	1313	FUNCTION reduceExpr_m(str, val) RESULT(lerr)
	1314	LOGICAL, ALLOCATABLE :: lerr(:)
	1315	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	1316	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
[4349]	1317	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1318	INTEGER :: i
	1319	ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
	1320	lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
	1321	END FUNCTION reduceExpr_m
	1322	!==============================================================================================================================
	1323
	1324
	1325	!==============================================================================================================================
	1326	!=== Check whether a string is a number or not ================================================================================
	1327	!==============================================================================================================================
	1328	ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
	1329	CHARACTER(LEN=*), INTENT(IN) :: str
	1330	REAL :: x
	1331	INTEGER :: e
	1332	CHARACTER(LEN=12) :: fmt
	1333	IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
	1334	WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
	1335	READ(str,fmt,IOSTAT=e) x
	1336	out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
	1337	END FUNCTION is_numeric
	1338	!==============================================================================================================================
	1339
	1340
	1341	!==============================================================================================================================
	1342	!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
	1343	!==============================================================================================================================
	1344	ELEMENTAL LOGICAL FUNCTION str2bool(str) RESULT(out)
	1345	CHARACTER(LEN=*), INTENT(IN) :: str
	1346	INTEGER :: ierr
	1347	READ(str,*,IOSTAT=ierr) out
	1348	IF(ierr==0) RETURN
	1349	out = ANY(['t ','true ','.true.','y ','yes ']==strLower(str))
	1350	END FUNCTION str2bool
	1351	!==============================================================================================================================
	1352	ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
	1353	CHARACTER(LEN=*), INTENT(IN) :: str
	1354	INTEGER :: ierr
	1355	READ(str,*,IOSTAT=ierr) out
	1356	IF(ierr/=0) out = -HUGE(1)
	1357	END FUNCTION str2int
	1358	!==============================================================================================================================
	1359	ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
	1360	CHARACTER(LEN=*), INTENT(IN) :: str
	1361	INTEGER :: ierr
	1362	READ(str,*,IOSTAT=ierr) out
	1363	IF(ierr/=0) out = -HUGE(1.)
	1364	END FUNCTION str2real
	1365	!==============================================================================================================================
	1366	ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
	1367	CHARACTER(LEN=*), INTENT(IN) :: str
	1368	INTEGER :: ierr
	1369	READ(str,*,IOSTAT=ierr) out
	1370	IF(ierr/=0) out = -HUGE(1.d0)
	1371	END FUNCTION str2dble
	1372	!==============================================================================================================================
	1373	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
	1374	LOGICAL, INTENT(IN) :: b
	1375	WRITE(out,*)b
	1376	out = ADJUSTL(out)
	1377	END FUNCTION bool2str
	1378	!==============================================================================================================================
	1379	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
	1380	INTEGER, INTENT(IN) :: i
	1381	INTEGER, OPTIONAL, INTENT(IN) :: nDigits
[4349]	1382	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1383	WRITE(out,*)i
	1384	out = ADJUSTL(out)
	1385	IF(.NOT.PRESENT(nDigits)) RETURN
	1386	IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
	1387	END FUNCTION int2str
	1388	!==============================================================================================================================
	1389	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
	1390	REAL, INTENT(IN) :: r
	1391	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
[4349]	1392	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1393	IF( PRESENT(fmt)) WRITE(out,fmt)r
	1394	IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
	1395	out = ADJUSTL(out)
	1396	END FUNCTION real2str
	1397	!==============================================================================================================================
	1398	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
	1399	DOUBLE PRECISION, INTENT(IN) :: d
	1400	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
[4349]	1401	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1402	IF( PRESENT(fmt)) WRITE(out,fmt)d
	1403	IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
	1404	out = ADJUSTL(out)
	1405	END FUNCTION dble2str
	1406	!==============================================================================================================================
[4193]	1407	ELEMENTAL SUBROUTINE cleanZeros(s)
	1408	CHARACTER(LEN=*), INTENT(INOUT) :: s
	1409	INTEGER :: ls, ix, i
	1410	IF(is_numeric(s)) THEN
	1411	ls = LEN_TRIM(s)
	1412	ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
	1413	IF(ix == 0) THEN
	1414	DO ix = ls,1,-1; IF(s(ix:ix) /= '0') EXIT; END DO; s=s(1:ix+1)
	1415	ELSE IF(INDEX(s,'.')/=0) THEN
	1416	i = ix-1; DO WHILE(s(i:i) == '0'); i = i-1; END DO; s=s(1:i)//s(ix:ls)
	1417	END IF
	1418	END IF
	1419	END SUBROUTINE cleanZeros
	1420	!==============================================================================================================================
[4046]	1421
[4349]	1422
[4046]	1423	!==============================================================================================================================
	1424	FUNCTION addQuotes_1(s) RESULT(out)
	1425	CHARACTER(LEN=*), INTENT(IN) :: s
	1426	CHARACTER(LEN=:), ALLOCATABLE :: out
	1427	IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
	1428	END FUNCTION addQuotes_1
	1429	!==============================================================================================================================
	1430	FUNCTION addQuotes_m(s) RESULT(out)
	1431	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1432	CHARACTER(LEN=:), ALLOCATABLE :: out(:)
[4349]	1433	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1434	INTEGER :: k, n
	1435	n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
	1436	ALLOCATE(CHARACTER(LEN=n) :: out(SIZE(s)))
	1437	DO k=1,SIZE(s)
	1438	IF(needQuotes(s(k))) THEN; out(k) = "'"//TRIM(s(k))//"'"; ELSE; out(k) = s(k); END IF
	1439	END DO
	1440	END FUNCTION addQuotes_m
	1441	!==============================================================================================================================
	1442	ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
	1443	CHARACTER(LEN=*), INTENT(IN) :: s
	1444	CHARACTER(LEN=1) :: b, e
[4349]	1445	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1446	out = .TRUE.; IF(TRIM(s) == '') RETURN
	1447	b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
	1448	out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
	1449	END FUNCTION needQuotes
	1450	!==============================================================================================================================
	1451
	1452
	1453	!==============================================================================================================================
	1454	!=== TEST WHETHER A FILE IS PRESENT OR NOT ====================================================================================
	1455	!==============================================================================================================================
	1456	LOGICAL FUNCTION testFile_1(fname) RESULT(out)
	1457	CHARACTER(LEN=*), INTENT(IN) :: fname
[4349]	1458	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1459	INTEGER :: ierr
	1460	OPEN(90, FILE=fname, FORM='formatted', STATUS='old', IOSTAT=ierr); CLOSE(99)
	1461	out = ierr/=0
	1462	END FUNCTION testFile_1
	1463	!==============================================================================================================================
	1464	FUNCTION testFile_m(fname) RESULT(out)
	1465	LOGICAL, ALLOCATABLE :: out(:)
	1466	CHARACTER(LEN=*), INTENT(IN) :: fname(:)
	1467	INTEGER :: k
[4349]	1468	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1469	out = [(testFile_1(fname(k)), k=1, SIZE(fname))]
	1470	END FUNCTION testFile_m
	1471	!==============================================================================================================================
	1472
	1473
	1474	!==============================================================================================================================
	1475	!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
	1476	!==============================================================================================================================
	1477	LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
	1478	! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
	1479	! Note: Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
	1480	CHARACTER(LEN=*), INTENT(IN) :: str(:)
	1481	LOGICAL, INTENT(IN) :: lerr(:)
	1482	CHARACTER(LEN=*), INTENT(IN) :: message, items, reason
	1483	INTEGER, OPTIONAL, INTENT(IN) :: nmax
[4349]	1484	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1485	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
	1486	INTEGER :: i, nmx
	1487	nmx = 256; IF(PRESENT(nmax)) nmx=nmax
	1488	out = ANY(lerr); IF(.NOT.out) RETURN
	1489	CALL msg(TRIM(message)//': the following '//TRIM(items)//' are '//TRIM(reason)//':')
	1490	s = strStackm(PACK(str, MASK=lerr), ', ',nmx)
	1491	DO i=1,SIZE(s,DIM=1); CALL msg(s(i)); END DO
	1492	END FUNCTION checkList
	1493	!==============================================================================================================================
	1494
	1495
	1496	!==============================================================================================================================
	1497	!=== Remove comment in line "str", ie all the characters from the first "#" sign found in "str". ==============================
	1498	!==============================================================================================================================
	1499	SUBROUTINE removeComment(str)
	1500	CHARACTER(LEN=*), INTENT(INOUT) :: str
	1501	INTEGER :: ix
	1502	ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)
	1503	END SUBROUTINE removeComment
	1504	!==============================================================================================================================
	1505
	1506
	1507	END MODULE strings_mod

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

Download in other formats:

Original Format