Context Navigation

strings_mod.f90 @ 5751

Last change on this file since 5751 was 5751, checked in by dcugnet, 26 hours ago

forgot to include horzcat_l??, horzcat_d21 and horzcat_?22 in the generic "cat" function
improve "dispTable", split in several routines (one each main stage), with some new possibilities:
- conversion into a string array ("convertTable")
- horizontal stacking of narrow tables ('gatherTable") If the total width is greater than "nColMax", table is split into several sub-tables. Each subtable includes the first "nHead" columns (names, indices...)
- titles can be displayed on a single line or several lines (depending on the rank of argument "titles": 1 or 2)

File size: 114.0 KB

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

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

Download in other formats:

Original Format