Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

source: strings_mod.F90

Last change on this file was 28, checked in by dcugnet, 22 months ago

rewrite few routines from "readTracFiles_mod" to avoid crashes with gfortran, in particular "setGeneration" and "addKey".
make "addKey" routine public and replace "addKey_m" and "addKey_mm" with callings to "addKey_1" in loops to avoid a gfortran-specific crash
rewrite the "getKey" functions family so that when "tname" is not specified, result is as expected, even for tracers lists with repeated tracers (use index instead of name search).
Bug correction for generation computation.
Fix the traceur.def backward compatibility issue.
Remove "config_inca" variable from "control_mod" and "infotrac_phy" (read in infotrac)
Cleaning: remove unused variables

File size: 85.4 KB

Line
1	MODULE strings_mod
2
3	IMPLICIT NONE
4
5	PRIVATE
6	PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
7	PUBLIC :: strLower, strHead, strStack, strCount, strReduce, strClean, strIdx
8	PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
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
27	INTERFACE find; MODULE PROCEDURE strFind, find_int, find_boo; END INTERFACE find
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
39	!==============================================================================================================================
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
45	!==============================================================================================================================
46
47
48	!==============================================================================================================================
49	SUBROUTINE init_printout(lunout_, prt_level_)
50	INTEGER, INTENT(IN) :: lunout_, prt_level_
51	lunout = lunout_
52	prt_level = prt_level_
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)
93	IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
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
110	!------------------------------------------------------------------------------------------------------------------------------
111	CHARACTER(LEN=maxlen) :: subn
112	INTEGER :: unt
113	subn = ''; IF(PRESENT(modname)) subn = modname
114	IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
115	unt = lunout; IF(PRESENT(unit)) unt = unit
116	IF(subn == '') WRITE(unt,'(a)') str !--- Simple message
117	IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str !--- Routine name provided
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
127	!------------------------------------------------------------------------------------------------------------------------------
128	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
129	CHARACTER(LEN=maxlen) :: subn
130	INTEGER :: unt, nmx, k
131	LOGICAL :: l
132	subn = ''; IF(PRESENT(modname)) subn = modname
133	l = .TRUE.; IF(PRESENT(ll)) l = ll
134	unt = lunout; IF(PRESENT(unit)) unt = unit
135	nmx = 128; IF(PRESENT(nmax)) nmx = nmax
136	s = strStackm(str, ', ', nmx)
137	DO k=1,SIZE(s); CALL msg_1(s(k), subn, l, unt); END DO
138	END SUBROUTINE msg_m
139	!==============================================================================================================================
140	LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
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
145	!------------------------------------------------------------------------------------------------------------------------------
146	CHARACTER(LEN=maxlen) :: subn
147	INTEGER :: unt
148	subn = ''; IF(PRESENT(modname)) subn = modname
149	l = .TRUE.; IF(PRESENT(ll)) l = ll
150	unt = lunout; IF(PRESENT(unit)) unt = unit
151	CALL msg_1(str, subn, l, unt)
152	END FUNCTION fmsg_1
153	!==============================================================================================================================
154	LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
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
160	!------------------------------------------------------------------------------------------------------------------------------
161	CHARACTER(LEN=maxlen) :: subn
162	INTEGER :: unt, nmx
163	subn = ''; IF(PRESENT(modname)) subn = modname
164	l = .TRUE.; IF(PRESENT(ll)) l = ll
165	unt = lunout; IF(PRESENT(unit)) unt = unit
166	nmx = 128; IF(PRESENT(nmax)) nmx = nmax
167	CALL msg_m(str, subn, l, unt, nmx)
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)
180	IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
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)
189	IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
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
205	!------------------------------------------------------------------------------------------------------------------------------
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
221	!------------------------------------------------------------------------------------------------------------------------------
222	LOGICAL :: lf
223	INTEGER :: k
224	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
225	IF(PRESENT(sep)) THEN
226	out = [(strHead_1(str(k), sep, lf), k=1, SIZE(str))]
227	ELSE
228	out = [(strHead_1(str(k), lFirst=lf), k=1, SIZE(str))]
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: ================
234	!=== * strTail(..,.FALSE.) = 'c' ${str#*$sep} ================
235	!=== * strTail(..,.TRUE.) = 'b_c' ${str##*$sep} ================
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
241	!------------------------------------------------------------------------------------------------------------------------------
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
257	!------------------------------------------------------------------------------------------------------------------------------
258	LOGICAL :: lf
259	INTEGER :: k
260	lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
261	IF(PRESENT(sep)) THEN
262	out = [(strTail_1(str(k), sep, lf), k=1, SIZE(str))]
263	ELSE
264	out = [(strTail_1(str(k), lFirst=lf), k=1, SIZE(str))]
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	!==============================================================================================================================
273	FUNCTION strStack(str, sep, mask) RESULT(out)
274	CHARACTER(LEN=:), ALLOCATABLE :: out
275	CHARACTER(LEN=*), INTENT(IN) :: str(:)
276	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
277	LOGICAL, OPTIONAL, INTENT(IN) :: mask(:)
278	!------------------------------------------------------------------------------------------------------------------------------
279	CHARACTER(LEN=:), ALLOCATABLE :: s
280	INTEGER :: is, i0
281	IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
282	ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
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
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
299	!------------------------------------------------------------------------------------------------------------------------------
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	!==============================================================================================================================
351	SUBROUTINE strReduce_1(str, nb)
352	CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
353	INTEGER, OPTIONAL, INTENT(OUT) :: nb
354	!------------------------------------------------------------------------------------------------------------------------------
355	CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
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)
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
365	IF(PRESENT(nb)) nb=n
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(:)
371	!------------------------------------------------------------------------------------------------------------------------------
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	!==============================================================================================================================
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 ============================
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(:)
404	!------------------------------------------------------------------------------------------------------------------------------
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(:)
419	!------------------------------------------------------------------------------------------------------------------------------
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(:)
429	!------------------------------------------------------------------------------------------------------------------------------
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(:)
439	!------------------------------------------------------------------------------------------------------------------------------
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
459	!------------------------------------------------------------------------------------------------------------------------------
460	INTEGER :: idx0 !--- Used to display an identified non-numeric string
461	lerr = .FALSE.
462	idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList"
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
465
466	!=== No delimiter found: the whole string must be a valid number
467	IF(idx == 0) THEN !--- No element of "del" in "rawList"
468	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- String must be a number
469	IF(lerr) idx = LEN_TRIM(rawList); RETURN !--- Set idx so that rawList(ibeg:idx-1) = whole string
470	END IF
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
477	IF(idx == 0) THEN
478	lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList))) !--- No other delimiter: whole string must be a valid numb
479	IF(lerr) idx = idx0; RETURN
480	END IF
481	lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
482
483	CONTAINS
484
485	!------------------------------------------------------------------------------------------------------------------------------
486	INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
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.
489	IMPLICIT NONE
490	CHARACTER(LEN=*), INTENT(IN) :: str, del(:)
491	INTEGER, INTENT(IN) :: ib
492	INTEGER, INTENT(OUT) :: id
493	!------------------------------------------------------------------------------------------------------------------------------
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
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	!==============================================================================================================================
505	LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
506	CHARACTER(LEN=*), INTENT(IN) :: rawList
507	CHARACTER(LEN=*), INTENT(IN) :: delimiter
508	INTEGER, INTENT(OUT) :: nb
509	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
510	!------------------------------------------------------------------------------------------------------------------------------
511	LOGICAL :: ll
512	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
513	lerr = strCount_1m(rawList, [delimiter], nb, ll)
514	END FUNCTION strCount_11
515	!==============================================================================================================================
516	LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
517	CHARACTER(LEN=*), INTENT(IN) :: rawList(:)
518	CHARACTER(LEN=*), INTENT(IN) :: delimiter
519	INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
520	LOGICAL, OPTIONAL, INTENT(IN) :: lSc
521	!------------------------------------------------------------------------------------------------------------------------------
522	LOGICAL :: ll
523	INTEGER :: id
524	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
525	lerr = .TRUE.
526	ALLOCATE(nb(SIZE(rawList)))
527	DO id = 1, SIZE(rawList)
528	lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
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
537	!------------------------------------------------------------------------------------------------------------------------------
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
549	IF(ie == 0 .OR. jd == 0) EXIT
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	!==============================================================================================================================
562	LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
563	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter
564	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
565	INTEGER, OPTIONAL, INTENT(OUT) :: n
566	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
567	!------------------------------------------------------------------------------------------------------------------------------
568	CHARACTER(LEN=1024) :: r
569	INTEGER :: nr, nk
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
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
580	IF(PRESENT(n)) n = nk
581
582	CONTAINS
583
584	!------------------------------------------------------------------------------------------------------------------------------
585	SUBROUTINE strParse_prv(nkeys, keys, vals)
586	!--- * Get the number of elements after parsing ("nkeys" only is present)
587	!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
588	IMPLICIT NONE
589	INTEGER, INTENT(OUT) :: nkeys
590	CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
591	CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
592	!------------------------------------------------------------------------------------------------------------------------------
593	INTEGER :: ib, ie
594	nkeys = 1; ib = 1
595	DO
596	ie = INDEX(rawList(ib:nr), delimiter)+ib-1 !--- Determine the next separator start index
597	IF(ie == ib-1) EXIT
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
600	ib = ie + LEN(delimiter)
601	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
602	nkeys = nkeys+1
603	END DO
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
606	END SUBROUTINE strParse_prv
607
608	!------------------------------------------------------------------------------------------------------------------------------
609	SUBROUTINE parseKeys(key, val)
610	CHARACTER(LEN=*), INTENT(INOUT) :: key
611	CHARACTER(LEN=*), INTENT(OUT) :: val
612	!------------------------------------------------------------------------------------------------------------------------------
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
620	!==============================================================================================================================
621	LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
622	CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter(:)
623	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:) !--- Parsed keys vector
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
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
628	!------------------------------------------------------------------------------------------------------------------------------
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
658	!------------------------------------------------------------------------------------------------------------------------------
659	SUBROUTINE parseKeys(key, val)
660	CHARACTER(LEN=*), INTENT(INOUT) :: key
661	CHARACTER(LEN=*), INTENT(OUT) :: val
662	!------------------------------------------------------------------------------------------------------------------------------
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
680	!------------------------------------------------------------------------------------------------------------------------------
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(:)
721	!------------------------------------------------------------------------------------------------------------------------------
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(:,:)
741	!------------------------------------------------------------------------------------------------------------------------------
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(:)
764	!------------------------------------------------------------------------------------------------------------------------------
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(:,:)
784	!------------------------------------------------------------------------------------------------------------------------------
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(:)
807	!------------------------------------------------------------------------------------------------------------------------------
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(:,:)
827	!------------------------------------------------------------------------------------------------------------------------------
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(:)
850	!------------------------------------------------------------------------------------------------------------------------------
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(:,:)
870	!------------------------------------------------------------------------------------------------------------------------------
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.
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.
897	!==============================================================================================================================
898	LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
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
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
908	INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen)
909	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name
910	!------------------------------------------------------------------------------------------------------------------------------
911	CHARACTER(LEN=2048) :: row
912	CHARACTER(LEN=maxlen) :: rFm, el, subn
913	CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
914	CHARACTER(LEN=1) :: s1, sp
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
919	LOGICAL :: ls, li, lr
920	subn = ''; IF(PRESENT(sub)) subn = sub
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
929	lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
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)
932	END IF
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)
935	END IF
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)
938	END IF
939	IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
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
944	nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
945
946	!--- Allocate the assembled quantities array
947	ALLOCATE(d(nmx,ncol), n(ncol))
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
958	END DO
959	CALL cleanZeros(d)
960	DO ic = 1, ncol
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
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
980	!--- Display the strings array as a table
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)
994	IF(ir /= 1) CYCLE !--- Titles only are underlined
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)
998	END DO
999	CALL msg('', subn, unit=unt)
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 ','
1015	!------------------------------------------------------------------------------------------------------------------------------
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
1039	IF(fmsg('display map "p" length and arguments number mismatch', ll=lerr)) RETURN
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
1058	END DO
1059	CALL cleanZeros(d)
1060	DO ic = 1, ncol
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	!==============================================================================================================================
1088	LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
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
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)
1099	!------------------------------------------------------------------------------------------------------------------------------
1100	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:)
1101	LOGICAL, ALLOCATABLE :: m(:)
1102	INTEGER, ALLOCATABLE :: ki(:), kj(:)
1103	INTEGER :: i, j, k, rk, rk1, ib, ie, itr, nm, unt, nRmx, nCmx, nHd, nv
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
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
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'
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)
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)
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)
1161	CALL msg("can't display outliers table", sub, lerr, unt)
1162	IF(lerr) RETURN
1163	END DO
1164	END FUNCTION dispOutliers_1
1165	!==============================================================================================================================
1166	LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
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
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)
1177	!------------------------------------------------------------------------------------------------------------------------------
1178	CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf
1179	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), vnm(:)
1180	INTEGER, ALLOCATABLE :: ki(:), kj(:), kl(:)
1181	INTEGER :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
1182	REAL, ALLOCATABLE :: val(:,:)
1183
1184	lerr = ANY(ll); IF(.NOT.lerr) RETURN !--- No outliers -> finished
1185	rk = SIZE(n); nv = SIZE(a,2)
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
1196
1197	SELECT CASE(rk) !--- Indices list
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
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)
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
1226	!------------------------------------------------------------------------------------------------------------------------------
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(:)
1279	!------------------------------------------------------------------------------------------------------------------------------
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
1287	IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN !--- Parse the values
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
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
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(:)
1317	!------------------------------------------------------------------------------------------------------------------------------
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
1382	!------------------------------------------------------------------------------------------------------------------------------
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
1392	!------------------------------------------------------------------------------------------------------------------------------
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
1401	!------------------------------------------------------------------------------------------------------------------------------
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	!==============================================================================================================================
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	!==============================================================================================================================
1421
1422
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(:)
1433	!------------------------------------------------------------------------------------------------------------------------------
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
1445	!------------------------------------------------------------------------------------------------------------------------------
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
1458	!------------------------------------------------------------------------------------------------------------------------------
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
1468	!------------------------------------------------------------------------------------------------------------------------------
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
1484	!------------------------------------------------------------------------------------------------------------------------------
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
1508

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

Download in other formats:

Original Format