Head

GCC Code Coverage Report

Directory:	./		Exec	Total	Coverage
File:	misc/strings_mod.F90	Lines:	226	654	34.6 %
Date:	2023-06-30 12:51:15	Branches:	490	2748	17.8 %

Line	Branch	Exec	Source
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		379	LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
40			LOGICAL, INTENT(IN) :: lcond
41			LOGICAL, INTENT(OUT) :: lout
42		379	lerr = lcond; lout = lcond
43		379	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		3588	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	✓✓	3588	subn = ''; IF(PRESENT(modname)) subn = modname
113	✓✓✓✓	3588	IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
114	✓✓	62	unt = lunout; IF(PRESENT(unit)) unt = unit
115	✗✓	62	IF(subn == '') WRITE(unt,'(a)') str !--- Simple message
116	✓✗	62	IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str !--- Routine name provided
117	✓✗	3588	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		66	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	✓✓	55	subn = ''; IF(PRESENT(modname)) subn = modname
148	✓✗	66	l = .TRUE.; IF(PRESENT(ll)) l = ll
149	✗✓	66	unt = lunout; IF(PRESENT(unit)) unt = unit
150		66	CALL msg_1(str, subn, l, unt)
151	✓✓	66	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		14	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		14	IF(PRESENT(sep)) THEN
206	✓✗✓✗	14	IF( PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
207	✗✓✗✗	14	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	✓✓✗✓	14	IF(out == '') out = str
213	✓✗	14	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		7	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		7	IF(PRESENT(sep)) THEN
242	✗✓✗✗	7	IF( PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
243	✓✗✓✗	7	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	✗✓✗✗	7	IF(out == '') out = str
249	✓✗	7	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	✗✓✗✗ ✗✗	11	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	✓✓	11	IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
281	✗✓✗✓ ✗✗✗✗ ✗✗	1	ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
282	✗✓✗✗	1	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	✓✗✗✗ ✓✗✓✓ ✓✗✓✗ ✓✗✗✓ ✓✗✓✗ ✓✗	6	out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
288			END IF
289	✗✓✗✗ ✓✗	22	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	✗✓	1	SUBROUTINE strClean_m(str)
339			CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
340			INTEGER :: k
341	✗✓	1	DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
342		1	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		1	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		1	IF(PRESENT(nb)) nb = 0
357		1	CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
358		1	n1 = SIZE(s1, DIM=1) !--- Total nb. of elements in "s1"
359	✗✓✗✓ ✗✗✗✗ ✗✓✗✗	1	n = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] ) !--- Nb of unique elements in "s1"
360	✓✗✓✗ ✗✓✗✓ ✗✓✗✓	2	ALLOCATE(str(n))
361	✓✗	2	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	✓✗✓✗ ✗✗	3	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	✗✓	405	INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
394			CHARACTER(LEN=*), INTENT(IN) :: str(:), s
395	✓✓✓✓	1622	DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
396	✓✓✗✓	405	IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
397		405	END FUNCTION strIdx_1
398			!==============================================================================================================================
399	✗✓✗✓	3	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	✗✓✓✓ ✓✗✓✓ ✗✓✗✗ ✗✓✓✗ ✗✗✓✓	39	out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
406	✗✓✗✗ ✗✗	3	IF(PRESENT(n)) n = COUNT(out(:)/=0)
407		3	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	✗✓	5	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	✗✓✓✓ ✓✗✓✓ ✓✗✓✓ ✗✓	80	out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
421	✓✗	5	IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
422		5	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	✗✓	11	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		11	idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList"
462	✓✗	11	IF(.NOT.PRESENT(lSc)) RETURN !--- No need to check exceptions for numbers => finished
463	✗✓	11	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	✗✓	11	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	✓✓✓✗	43	DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
494	✓✗	11	IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
495		11	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		10	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	✓✗✓✓ ✗✓	30	lerr = strCount_1m(rawList, [delimiter], nb, ll)
513	✗✓	10	END FUNCTION strCount_11
514			!==============================================================================================================================
515		2	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	✗✓✗✗ ✗✗	1	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
524			lerr = .TRUE.
525	✓✗✗✓ ✗✓	1	ALLOCATE(nb(SIZE(rawList)))
526	✓✓	2	DO id = 1, SIZE(rawList)
527	✓✗✓✓ ✗✓✓✗ ✓✗	5	lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
528			END DO
529	✗✓	1	END FUNCTION strCount_m1
530			!==============================================================================================================================
531		22	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		11	lerr = .FALSE.
541	✓✗	11	ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
542	✓✗	11	r = TRIM(ADJUSTL(rawList))
543	✗✓	11	nr = LEN_TRIM(r); IF(nr == 0) RETURN
544		11	nb = 1; ib = 1
545			DO
546		11	lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
547	✗✓✗✓	11	IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
548	✗✓✗✗	11	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	✗✓	22	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		20	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	✓✓	20	r = TRIM(ADJUSTL(rawList))
571	✗✓✗✗ ✗✗✗✗ ✗✗✗✗ ✗✗	20	nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
572		20	CALL strParse_prv(nk) !--- COUNT THE ELEMENTS
573	✓✗✗✓ ✗✓	20	ALLOCATE(keys(nk))
574	✓✓	20	IF(PRESENT(vals)) THEN
575	✗✓✗✓	6	ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals) !--- PARSE THE KEYS
576			ELSE
577		14	CALL strParse_prv(nk, keys) !--- PARSE THE KEYS
578			END IF
579	✓✓	60	IF(PRESENT(n)) n = nk
580
581			CONTAINS
582
583			!------------------------------------------------------------------------------------------------------------------------------
584	✓✓✓✗ ✗✓✓✓ ✓✗✗✓	40	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		40	nkeys = 1; ib = 1
594		28	DO
595		68	ie = INDEX(rawList(ib:nr), delimiter)+ib-1 !--- Determine the next separator start index
596	✓✓	68	IF(ie == ib-1) EXIT
597	✓✓✓✗ ✓✗	28	IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1) !--- Get the ikth key
598	✓✓✓✗	28	IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys)) !--- Parse the ikth <key>=<val> pair
599		28	ib = ie + LEN(delimiter)
600	✓✓✓✗	200	DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain
601		28	nkeys = nkeys+1
602			END DO
603	✓✓✓✗ ✓✗	40	IF(PRESENT(keys)) keys(nkeys) = r(ib:nr) !--- Get the last key
604	✓✓✓✗	40	IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys)) !--- Parse the last <key>=<val> pair
605		40	END SUBROUTINE strParse_prv
606
607			!------------------------------------------------------------------------------------------------------------------------------
608		20	SUBROUTINE parseKeys(key, val)
609			CHARACTER(LEN=*), INTENT(INOUT) :: key
610			CHARACTER(LEN=*), INTENT(OUT) :: val
611			!------------------------------------------------------------------------------------------------------------------------------
612			INTEGER :: ix
613		20	ix = INDEX(key, '='); IF(ix == 0) RETURN !--- First "=" index in "key"
614	✓✗✓✗	14	val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
615	✓✗✓✗	14	key = ADJUSTL(key(1:ix-1))
616	✓✓	20	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	✓✗✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✗✓✗✗ ✗✗✗✓	4	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	✓✗✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✗✓✗✗ ✓✓	63	PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
746	✓✓✓✓	44	nrow = SIZE(s0); ncol=COUNT(lv)
747	✓✗✓✗ ✗✓✗✓ ✗✓	8	ALLOCATE(out(nrow, ncol))
748	✓✓	25	DO iv=1, ncol
749		4	SELECT CASE(iv)
750		14	CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
751	✓✓✓✓ ✓✓✓✓ ✓✗✗	21	CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
752			END SELECT
753		21	n = SIZE(s, DIM=1)
754	✗✓	21	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
755	✓✓	130	out(:,iv) = s(:)
756			END DO
757		4	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	✓✗✓✗ ✗✓✓✗ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✓✓ ✓✗✗✓ ✓✓✓✗ ✗✓✗✓	4	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	✓✗✗✓ ✓✗✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓✗✓ ✓✓	59	PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
789	✓✓✓✓	44	nrow = SIZE(i0); ncol=COUNT(lv)
790	✓✗✗✓ ✗✓	4	ALLOCATE(out(nrow, ncol))
791	✓✓	29	DO iv=1, ncol
792		4	SELECT CASE(iv)
793		16	CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
794	✓✓✓✓ ✓✓✓✓ ✓✓✗	25	CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
795			END SELECT
796		25	n = SIZE(i, DIM=1)
797	✗✓	25	IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
798	✓✓	154	out(:,iv) = i(:)
799			END DO
800		4	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	✓✗✗✓ ✓✗✓✗ ✗✓✗✓ ✗✗✗✗ ✗✓	4	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	✓✗✓✓	4	subn = ''; IF(PRESENT(sub)) subn = sub
920	✗✓✗✗	4	rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals
921	✗✓	4	unt = lunout; IF(PRESENT(unit)) unt = unit !--- Specified output unit
922		4	np = LEN_TRIM(p); ns = 0; ni = 0; nr = 0; ncol = 0
923	✓✗✗✓ ✓✗✗✓ ✗✓✗✗	4	ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
924	✗✓✗✗	4	lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN !--- Nothing to do
925			sp = '\|' !--- Separator
926
927			!--- CHECK ARGUMENTS COHERENCE
928	✗✓	4	lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
929	✓✗	4	IF(ls) THEN
930	✗✓✓✓ ✓✓✓✓	96	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	✓✗	4	IF(li) THEN
933	✗✓✓✓ ✓✓✓✓	96	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	✗✓	4	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	✗✓	4	IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
939	✗✓	4	lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', subn, lerr)) RETURN
940	✓✗✓✗ ✗✓	8	lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', subn, lerr)) RETURN
941	✗✓✗✗ ✗✓	8	lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg( 'string and real arguments lengths mismatch', subn, lerr)) RETURN
942	✗✓✗✗ ✗✓	8	lerr = li.AND.lr.AND.ni/=nr; IF(fmsg( 'integer and real arguments lengths mismatch', subn, lerr)) RETURN
943	✗✓	4	nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
944
945			!--- Allocate the assembled quantities array
946	✓✗✓✗ ✗✓✗✓ ✓✗✗✓	8	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	✓✓	50	DO ic = 1, ncol
951	✓✗	46	d(1,ic) = TRIM(titles(ic))
952		4	SELECT CASE(p(ic:ic))
953	✓✓✗✓	126	CASE('s'); d(2:nmx,ic) = s(:,is) ; is = is + 1
954	✓✓	150	CASE('i'); d(2:nmx,ic) = int2str(i(:,ii) ); ii = ii + 1
955	✓✓✗✗ ✗✗	46	CASE('r'); d(2:nmx,ic) = real2str(r(:,ir),rFm); ir = ir + 1
956			END SELECT
957			END DO
958	✓✓✓✓	326	CALL cleanZeros(d)
959	✓✓	50	DO ic = 1, ncol
960	✓✓	326	n(ic)=0; DO ir=1, nmx; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
961			END DO
962	✓✓	50	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	✓✗	4	nHd = 1; IF(PRESENT(nHead)) nHd = nHead
966	✗✓	4	IF(.NOT.PRESENT(nColMax)) THEN
967			nt = 1; ncmx = [ncol]
968			ELSE
969	✓✓	12	nt = 1; l0 = SUM(n(1:nHd)+1)+1
970	✓✗	4	IF(PRESENT(sub)) l0=l0+LEN_TRIM(subn)+1
971			!--- Count the number of table parts
972	✓✓✗✓	42	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	✓✗✗✓	4	ALLOCATE(ncmx(nt)); k = 1
975	✓✓✗✓	42	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		4	ncmx(nt) = ncol
977			END IF
978
979			!--- Display the strings array as a table
980	✓✓	8	DO it = 1, nt
981	✓✓	28	DO ir = 1, nmx; row = ''
982	✓✓	72	DO ic = 1, nHd; el = d(ir,ic)
983		48	s1 = sp
984	✗✓✓✓ ✓✗	174	row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
985			END DO
986	✗✓	24	ib = nHd+1; IF(it>1) ib = ncmx(it-1)+1
987	✓✓	252	DO ic = ib, ncmx(it); el = d(ir,ic)
988		228	s1 = sp
989	✗✓✓✓ ✓✗	1100	row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
990			END DO
991		24	nr = LEN_TRIM(row)-1 !--- Final separator removed
992		24	CALL msg(row(1:nr), subn, unit=unt)
993	✓✓	24	IF(ir /= 1) CYCLE !--- Titles only are underlined
994	✓✓✗✓ ✓✓✓✗	54	row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
995	✓✓✗✓ ✓✓✓✗	320	DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
996		28	CALL msg(row(1:LEN_TRIM(row)-1), subn, unit=unt)
997			END DO
998		8	CALL msg('', subn, unit=unt)
999			END DO
1000
1001	✓✗✓✗ ✓✗✓✗	8	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		276	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	✓✗	276	IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
1333		276	WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
1334		276	READ(str,fmt,IOSTAT=e) x
1335	✓✓✗✓	276	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		20	ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
1352			CHARACTER(LEN=*), INTENT(IN) :: str
1353			INTEGER :: ierr
1354		20	READ(str,*,IOSTAT=ierr) out
1355	✗✓	20	IF(ierr/=0) out = -HUGE(1)
1356		20	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		15	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
1373			LOGICAL, INTENT(IN) :: b
1374		15	WRITE(out,*)b
1375		15	out = ADJUSTL(out)
1376		15	END FUNCTION bool2str
1377			!==============================================================================================================================
1378		1913	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
1379			INTEGER, INTENT(IN) :: i
1380			INTEGER, OPTIONAL, INTENT(IN) :: nDigits
1381			!------------------------------------------------------------------------------------------------------------------------------
1382		1913	WRITE(out,*)i
1383		1913	out = ADJUSTL(out)
1384	✓✓	1913	IF(.NOT.PRESENT(nDigits)) RETURN
1385	✓✗✓✓	1188	IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
1386			END FUNCTION int2str
1387			!==============================================================================================================================
1388		5	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
1389			REAL, INTENT(IN) :: r
1390			CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
1391			!------------------------------------------------------------------------------------------------------------------------------
1392	✗✓	5	IF( PRESENT(fmt)) WRITE(out,fmt)r
1393	✓✗	5	IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
1394		5	out = ADJUSTL(out)
1395		5	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		276	ELEMENTAL SUBROUTINE cleanZeros(s)
1407			CHARACTER(LEN=*), INTENT(INOUT) :: s
1408			INTEGER :: ls, ix, i
1409		276	IF(is_numeric(s)) THEN
1410		125	ls = LEN_TRIM(s)
1411		125	ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
1412	✓✗	125	IF(ix == 0) THEN
1413	✓✓✓✓ ✓✗✓✗	225	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	✓✓	276	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	✗✓✗✓	4	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	✗✓	4	nmx = 256; IF(PRESENT(nmax)) nmx=nmax
1466	✓✓✓✗ ✗✓	20	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	✗✓	4	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		8	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	✗✓	8	END SUBROUTINE removeComment
1482			!==============================================================================================================================
1483
1484
1485			END MODULE strings_mod


Generated by: GCOVR (Version 4.2)