Context Navigation

strings_mod.F90 @ 4911

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

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

Download in other formats:

Original Format