Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

swift_string_op.F90 @ 3590

Last change on this file since 3590 was 3560, checked in by debatzbr, 7 weeks ago
Addition of the microphysics model in moments.
File size: 101.2 KB

Line
1	! Copyright (c) Jeremie Burgalat (2013-2022)
2	! Contributor: Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
3	!
4	! This file is part of SWIFT
5	!
6	! Permission is hereby granted, free of charge, to any person obtaining a copy of
7	! this software and associated documentation files (the "Software"), to deal in
8	! the Software without restriction, including without limitation the rights to
9	! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
10	! the Software, and to permit persons to whom the Software is furnished to do so,
11	! subject to the following conditions:
12	!
13	! The above copyright notice and this permission notice shall be included in all
14	! copies or substantial portions of the Software.
15	!
16	! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17	! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
18	! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
19	! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
20	! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21	! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
23	!! File: swift_string_op.F90
24	!! Summary: Strings manipulation source file
25	!! Author: J. Burgalat
26	!! Date: 2013-2022
27
28	#include "swift_defined.h"
29
30	MODULE SWIFT_STRING_OP
31	!! Fortran strings manipulation module
32	!!
33	!! This module provides methods and objects to manipulate Fortran (allocatable) strings. It defines
34	!! a doubly linked-list of strings, [[string_op(module):words(type)]] and several methods to format
35	!! strings or convert them in other intrinsic types.
36	USE SWIFT_ERRORS
37	IMPLICIT NONE
38
39	PRIVATE
40
41	PUBLIC :: str2dble_sc,str2dble_ve,str2real_sc,str2real_ve
42	! errors module (not used but propagated)
43	PUBLIC :: stdout,stderr,noerror,error, error_to_string,aborting
44
45	! misc module methods
46	PUBLIC :: to_string, from_string, string_is, remove_quotes, format_string, &
47	format_paragraph, strip_newline, tokenize, str_length, endswith, &
48	startswith, to_lower, to_upper, add_csi, &
49	del_csi, reset_csi, str_remove, str_replace,&
50	fancy
51
52	! words object related methods
53	PUBLIC :: words_length, words_insert, words_append, words_prepend, words_get, &
54	words_set, words_get_max_width, words_get_total_width, words_pop, &
55	words_remove, words_next, words_previous, words_reset, &
56	words_valid, words_current, words_extend, words_reverse, &
57	words_reversed, words_dump, words_to_string, words_to_vector, &
58	words_clear
59
60	PRIVATE :: fis_affect_int, fis_affect_bool, fis_affect_real, &
61	fis_affect_double, fis_affect_cplx, fis_affect_dcplx, &
62	fis_cat_int, fis_cat_bool, fis_cat_real, fis_cat_double, &
63	fis_cat_cplx, fis_cat_dcplx, fis_cat_int_inv, &
64	fis_cat_bool_inv, fis_cat_real_inv, fis_cat_double_inv, &
65	fis_cat_cplx_inv, fis_cat_dcplx_inv
66
67	! Operators
68	PUBLIC :: ASSIGNMENT(=), OPERATOR(/=), OPERATOR(==)
69
70	INTEGER, PUBLIC, PARAMETER :: st_string = 1 !! String type ID
71	INTEGER, PUBLIC, PARAMETER :: st_logical = 2 !! Logical type ID
72	INTEGER, PUBLIC, PARAMETER :: st_complex = 3 !! Complex type ID
73	INTEGER, PUBLIC, PARAMETER :: st_integer = 4 !! Integer type ID
74	INTEGER, PUBLIC, PARAMETER :: st_real = 5 !! Real type ID
75
76	!> List of types names
77	CHARACTER(len=*), DIMENSION(5), PARAMETER, PUBLIC :: st_type_names = &
78	(/ 'string ', 'logical', 'complex', 'integer', 'real '/)
79
80	INTEGER, PUBLIC, PARAMETER :: st_slen = SSLEN !! Maximum short string length
81	INTEGER, PUBLIC, PARAMETER :: st_llen = SLLEN !! Maximum long string length
82
83
84
85	INTEGER, PUBLIC, PARAMETER :: FC_BLACK = 30 !! Black foreground csi code
86	INTEGER, PUBLIC, PARAMETER :: FC_RED = 31 !! Red foreground csi code
87	INTEGER, PUBLIC, PARAMETER :: FC_GREEN = 32 !! Green foreground csi code
88	INTEGER, PUBLIC, PARAMETER :: FC_YELLOW = 33 !! Yellow foreground csi code
89	INTEGER, PUBLIC, PARAMETER :: FC_BLUE = 34 !! Blue foreground csi code
90	INTEGER, PUBLIC, PARAMETER :: FC_MAGENTA = 35 !! Magenta foreground csi code
91	INTEGER, PUBLIC, PARAMETER :: FC_CYAN = 36 !! Cyan foreground csi code
92	INTEGER, PUBLIC, PARAMETER :: FC_WHITE = 37 !! White foreground csi code
93	INTEGER, PUBLIC, PARAMETER :: BG_BLACK = 40 !! Black foreground csi code
94	INTEGER, PUBLIC, PARAMETER :: BG_RED = 41 !! Black background csi code
95	INTEGER, PUBLIC, PARAMETER :: BG_GREEN = 42 !! Green background csi code
96	INTEGER, PUBLIC, PARAMETER :: BG_YELLOW = 43 !! Yellow background csi code
97	INTEGER, PUBLIC, PARAMETER :: BG_BLUE = 44 !! Blue background csi code
98	INTEGER, PUBLIC, PARAMETER :: BG_MAGENTA = 45 !! Magenta background csi code
99	INTEGER, PUBLIC, PARAMETER :: BG_CYAN = 46 !! Cyan background csi code
100	INTEGER, PUBLIC, PARAMETER :: BG_WHITE = 47 !! White background csi code
101	INTEGER, PUBLIC, PARAMETER :: ST_NORMAL = 0 !! Normal (regular) attribute
102	INTEGER, PUBLIC, PARAMETER :: ST_BOLD = 1 !! Bold (brighter) attribute
103	INTEGER, PUBLIC, PARAMETER :: ST_ITALIC = 3 !! Italic attribute (sometimes reverse video or underline)
104	INTEGER, PUBLIC, PARAMETER :: ST_UNDERLINE = 4 !! Underline attribute
105	INTEGER, PUBLIC, PARAMETER :: ST_BLINK = 5 !! Slow blink mode
106	!> List of all attributes in a vector
107	INTEGER, PUBLIC, PARAMETER, DIMENSION(21) :: attributes = [FC_BLACK, &
108	FC_RED, &
109	FC_GREEN, &
110	FC_YELLOW, &
111	FC_BLUE, &
112	FC_MAGENTA, &
113	FC_CYAN, &
114	FC_WHITE, &
115	BG_BLACK, &
116	BG_RED, &
117	BG_GREEN, &
118	BG_YELLOW, &
119	BG_BLUE, &
120	BG_MAGENTA, &
121	BG_CYAN, &
122	BG_WHITE, &
123	ST_NORMAL, &
124	ST_BOLD, &
125	ST_ITALIC, &
126	ST_UNDERLINE, &
127	ST_BLINK &
128	]
129
130	!> Aliases for CSI codes.
131	CHARACTER(len=2), DIMENSION(21), PARAMETER, PUBLIC :: csis =(/ &
132	"fk", "fr", "fg", "fy", "fb", "fm", "fc", "fw", &
133	"bk", "br", "bg", "by", "bb", "bm", "bc", "bw", &
134	"sn", "sb", "si", "su", "sk"/)
135
136	!> [[words(type)]] object assignement interface
137	INTERFACE ASSIGNMENT(=)
138	MODULE PROCEDURE ws_affect
139	END INTERFACE
140
141	!> Clear either a scalar or a vector of list of [[words(type)]]
142	!!
143	!! The interface encapsulates words _destructors_, that deallocate memory used
144	!! by the given list(s) of words. This method should be called anytime words
145	!! object(s) is no longer used to avoid memory leaks.
146	!! @note
147	!! If the library support Derived type finalization, calling destructor is not
148	!! mandatory.
149	INTERFACE words_clear
150	MODULE PROCEDURE ws_clear_sc, ws_clear_ve
151	END INTERFACE
152
153	!> Extend a given [[words(type)]] object either by another or by a string
154	!!
155	!! The interface encapsulates two subroutines:
156	!!
157	!! - [[ws_extend_ws(subroutine)]](this,other) which extends __this__ by __other__
158	!! (both are words objects).
159	!! - [[ws_extend_str(subroutine)]](this,str,delimiter,merge) which splits __str__
160	!! according to __delimiter__ (and optionally __merge__) and then extends
161	!! __this__ with the resulting tokens.
162	INTERFACE words_extend
163	MODULE PROCEDURE ws_extend_ws,ws_extend_str
164	END INTERFACE
165
166	!> Convert an intrinsic type value to a string
167	!!
168	!! This (very) generic interface provides conversion functions from
169	!! intrinsic types to ALLOCATED string.
170	!!
171	!! ```
172	!! (1) FUNCTION to_string(value) RESULT(str)
173	!! (2) FUNCTION to_string(value,fmt) RESULT(str)
174	!! ```
175	!! Where :
176	!!
177	!! - __value__ is the value to convert
178	!! - __fmt__ is a string the format descriptor of the output string. Surrounding
179	!! parenthesis can be omitted.
180	!! - __str__ is an allocatable string with the converted value in output, or an empty
181	!! string if the conversion failed.
182	INTERFACE to_string
183	MODULE PROCEDURE int2str_as,int2str_fs
184	MODULE PROCEDURE log2str_as,log2str_fs
185	MODULE PROCEDURE real2str_as,real2str_fs
186	MODULE PROCEDURE dble2str_as,dble2str_fs
187	MODULE PROCEDURE cplx2str_as,cplx2str_fs
188	MODULE PROCEDURE dcplx2str_as,dcplx2str_fs
189	END INTERFACE
190
191	!> Convert a string into an intrisinc type
192	!!
193	!! All methods defined in the interface are functions which take in arguments,
194	!! a string (input) and an output variable with the relevant type (or vectors of both).
195	!! They always return an error object which is set to -5 error code (i.e. cannot cast value)
196	!! on error, otherwise [[errors(module):noerror(variable)]].
197	INTERFACE from_string
198	MODULE PROCEDURE str2int_sc,str2log_sc,str2real_sc,str2dble_sc,str2cplx_sc
199	MODULE PROCEDURE str2int_ve,str2log_ve,str2real_ve,str2dble_ve,str2cplx_ve
200	END INTERFACE
201
202	!> Compute a fancy string
203	!!
204	!! The generic interface adds CSI codes to the given value and returns a fortran intrinsic string.
205	!!
206	!! This is convinient wrapper to [[string_op(module):to_string(interface)]] and
207	!! [[string_op(module):add_csi(function)]].
208	!!
209	!! ```fortran
210	!! FUNCTION fancy(value, flags) RESULT(str)
211	!! ```
212	!!
213	!! value can be either a INTEGER, REAL, REAL(kind=8), COMPLEX, COMPLEX(kind=8) or STRING.
214	!!
215	!! **flags is a vector of (string) attributes that can take the values as defined in the second
216	!! column of the [list of csi attributes](\|url\|/page/swift/p02_strings.html#fancy-strings).
217	INTERFACE fancy
218	MODULE PROCEDURE fancy_fstr, fancy_int, fancy_real, fancy_double, fancy_cplx, fancy_dcplx
219	END INTERFACE
220
221	!> Overloaded string assignment operator interface
222	INTERFACE ASSIGNMENT(=)
223	MODULE PROCEDURE fis_affect_int, fis_affect_bool, fis_affect_real, &
224	fis_affect_double, fis_affect_cplx, fis_affect_dcplx
225	END INTERFACE
226
227	!> Overloaded string concatentation operator interface
228	INTERFACE OPERATOR(//)
229	MODULE PROCEDURE fis_cat_int, fis_cat_bool, fis_cat_real, fis_cat_double, &
230	fis_cat_cplx, fis_cat_dcplx
231	MODULE PROCEDURE fis_cat_int_inv, fis_cat_bool_inv, fis_cat_real_inv, &
232	fis_cat_double_inv, fis_cat_cplx_inv, fis_cat_dcplx_inv
233	END INTERFACE
234
235	!> Define a linked word
236	!!
237	!! Linked words are only intended to be used within a words type.
238	!! It's part of the doubly linked list words.
239	TYPE, PUBLIC :: word
240	#if HAVE_FTNDTSTR
241	CHARACTER(len=:), ALLOCATABLE :: value !! Value of the word
242	#else
243	!> Value of the word
244	!!
245	!! @warning
246	!! It is always limited to [[string_op(module):st_slen(variable)]] characters.
247	CHARACTER(len=st_slen) :: value = ''
248	#endif
249	TYPE(word), PRIVATE, POINTER :: next => null() !! Next word in the list of words
250	TYPE(word), PRIVATE, POINTER :: prev => null() !! Previous word in the list of words
251	END TYPE word
252
253	!> Define a list of words
254	TYPE, PUBLIC :: words
255	INTEGER, PRIVATE :: nw = 0 !! Number of word in the list
256	TYPE(word), PRIVATE, POINTER :: head => null() !! First word in the list
257	TYPE(word), PRIVATE, POINTER :: tail => null() !! Last word in the list
258	TYPE(word), PRIVATE, POINTER :: iter => null() !! Current word (iterator)
259	#if HAVE_FTNPROC
260	CONTAINS
261	PROCEDURE, PRIVATE :: ws_extend_ws
262	PROCEDURE, PRIVATE :: ws_extend_str
263	PROCEDURE, PUBLIC :: length => words_length
264	!! Get the number of words in the list
265	PROCEDURE, PUBLIC :: insert => words_insert
266	!! Insert a word at given index
267	PROCEDURE, PUBLIC :: append => words_append
268	!! Append a word at the end of the list
269	PROCEDURE, PUBLIC :: prepend => words_prepend
270	!! Prepend a word at the beginning of the list
271	PROCEDURE, PUBLIC :: get => words_get
272	!! Get the word at given index
273	PROCEDURE, PUBLIC :: set => words_set
274	!! Set a word at given index
275	PROCEDURE, PUBLIC :: max_width => words_get_max_width
276	!! Get the width of the biggest word in the list
277	PROCEDURE, PUBLIC :: total_width => words_get_total_width
278	!! Get the total width of the words stored in the list
279	PROCEDURE, PUBLIC :: reverse => words_reverse
280	!! Reverse the list in place
281	PROCEDURE, PUBLIC :: reversed => words_reversed
282	!! Get a reversed copy of the list
283	PROCEDURE, PUBLIC :: dump => words_dump
284	!! Dump words of the list (on per line)
285	PROCEDURE, PUBLIC :: tostring => words_to_string
286	!! Convert the list in a single string
287	PROCEDURE, PUBLIC :: to_vector => words_to_vector
288	!! Convert the list in a vector
289	PROCEDURE, PUBLIC :: pop => words_pop
290	!! Pop a word from the list and returns it
291	PROCEDURE, PUBLIC :: remove => words_remove
292	!! Remove a word from the list
293	PROCEDURE, PUBLIC :: next => words_next
294	!! Go to the next word in the list
295	PROCEDURE, PUBLIC :: previous => words_previous
296	!! Go to the previous word in the list
297	PROCEDURE, PUBLIC :: reset => words_reset
298	!! Reset the list's iterator
299	PROCEDURE, PUBLIC :: valid => words_valid
300	!! Check if iterator position is valid
301	PROCEDURE, PUBLIC :: current => words_current
302	!! Get the current word in the list
303	GENERIC, PUBLIC :: extend => ws_extend_ws,ws_extend_str
304	!! Extend a list with either a string or another list of words
305	#endif
306	END TYPE words
307
308	CONTAINS
309
310	FUNCTION word_length(this) RESULT(lgth)
311	!! Get the trimmed length of the word object
312	TYPE(word), INTENT(in) :: this
313	!! A word object
314	INTEGER :: lgth
315	!! The length of the word's value (without trailing spaces)
316	#if HAVE_FTNDTSTR
317	IF (.NOT.ALLOCATED(this%value)) THEN
318	lgth = 0 ; RETURN
319	ENDIF
320	#endif
321	lgth = LEN_TRIM(this%value)
322	RETURN
323	END FUNCTION word_length
324
325	SUBROUTINE disconnect_word(this)
326	!! Disconnect a word object
327	!!
328	!! The object is no more connected to its neighbours which are connected together.
329	!! @note
330	!! After this method is called the object is no longer connected to its parent words
331	!! object and should be deallocated in order to avoid memory leaks.
332	TYPE(word), INTENT(inout) :: this
333	!! A word object to disconnect
334	TYPE(word), POINTER :: pw,nw
335	nw => this%next ; pw => this%prev
336	IF (ASSOCIATED(nw)) nw%prev => pw
337	IF (ASSOCIATED(pw)) pw%next => nw
338	RETURN
339	END SUBROUTINE disconnect_word
340
341	SUBROUTINE ws_affect(this,other)
342	!! words object assignment operator subroutine
343	TYPE(words), INTENT(out) :: this
344	!! A words object to be assigned
345	TYPE(words), INTENT(in) :: other
346	!! A words object to assign
347	TYPE(word), POINTER :: cur
348	CALL ws_clear_sc(this)
349	IF (other%nw == 0) THEN
350	RETURN
351	ELSE
352	cur => other%head
353	DO WHILE(associated(cur))
354	#if HAVE_FTNDTSTR
355	IF (.NOT.ALLOCATED(cur%value)) THEN
356	CALL words_append(this,"")
357	ELSE
358	CALL words_append(this,cur%value)
359	ENDIF
360	#else
361	CALL words_append(this,cur%value)
362	#endif
363	IF (ASSOCIATED(cur,other%iter)) this%iter => this%tail
364	cur => cur%next
365	ENDDO
366	ENDIF
367	RETURN
368	END SUBROUTINE ws_affect
369
370	SUBROUTINE ini_word(this,value)
371	!! Initialize the first word of a list of words
372	!!
373	!! This subroutine is not a constructor. It is only intended to set the first word
374	!! object in a words object.
375	TYPE(words), INTENT(inout) :: this
376	!! A words object reference
377	CHARACTER(len=*), INTENT(in) :: value
378	!! A string with the word used to initialize the list
379	ALLOCATE(this%head)
380	this%tail => this%head
381	ASSIGN_DTSTR(value,this%tail%value)
382	this%nw = 1
383	RETURN
384	END SUBROUTINE ini_word
385
386	SUBROUTINE ws_clear_sc(obj)
387	!! Clear a list of words
388	!!
389	!! This subroutine deallocates all memory used by the given words object.
390	!! @warning
391	!! The subroutine should be called whenever a words is no more used (e.g. at
392	!! the end of the current scope), otherwise memory leaks could occur.
393	TYPE(words),INTENT(inout), TARGET :: obj
394	!! A words object to clear
395	TYPE(word), POINTER :: cur,next
396	IF (obj%nw == 0) RETURN
397	cur => obj%head
398	DO WHILE(ASSOCIATED(cur))
399	next => cur%next
400	CALL disconnect_word(cur)
401	#if HAVE_FTNDTSTR
402	IF (ALLOCATED(cur%value)) DEALLOCATE(cur%value)
403	#endif
404	DEALLOCATE(cur)
405	cur => next
406	ENDDO
407	obj%nw = 0
408	obj%head => null() ; obj%tail => null() ; obj%iter => null()
409	END SUBROUTINE ws_clear_sc
410
411	SUBROUTINE ws_clear_ve(objs)
412	!! Clear a vector of list of words
413	!!
414	!! This subroutine deallocates all memory used by the given vector of words objects.
415	!! @warning
416	!! The subroutine should be called whenever a words is no more used (e.g. at the end
417	!! of the current scope), otherwise memory leaks could occur.
418	TYPE(words),INTENT(inout), DIMENSION(:) :: objs
419	!! A vector of words objects to clear
420	TYPE(word), POINTER :: cur,next
421	INTEGER :: i
422	DO i=1,SIZE(objs)
423	call ws_clear_sc(objs(i))
424	ENDDO
425	END SUBROUTINE ws_clear_ve
426
427	SUBROUTINE ws_extend_ws(this, other)
428	!! Extend a list of words with another one
429	OBJECT(words), INTENT(inout) :: this
430	!! A words object to extend
431	TYPE(words), INTENT(in) :: other
432	!! A words object to extend with
433	TYPE(word), POINTER :: cw
434	IF (other%nw == 0) RETURN
435	cw => other%head
436	DO WHILE(ASSOCIATED(cw))
437	CALL words_append(this,cw%value) ; cw => cw%next
438	ENDDO
439	RETURN
440	END SUBROUTINE ws_extend_ws
441
442	SUBROUTINE ws_extend_str(this,str,delimiter,merge,protect)
443	!> Extend a list of word with a given string
444	!! @details The method adds a new list of words to the current list by
445	!! splitting a string using a set of delimiters.
446	!!
447	!! - If __delimiter__ is not given, THEN blank space is used.
448	!! - __delimiter__ can be a string of any length, but each character of
449	!! the sequence is seen as a single delimiter. Each time one of these
450	!! special character is seen on the string, it is splitted.
451	!! - If __protect__ is set to .true. THEN delimiter enclosed by
452	!! either single or double quotes are protected.
453	!! - The optional argument __merge__ instructs the method wether to merge
454	!! or not successive delimiters in the string.
455	!!
456	!! For example, considering the following string:
457	!! <center>@verbatim "I like coffee and bananas." @endverbatim</center>
458	!! - Used with only __delimiter__ = " e", the method returns the list:
459	!! <center>"I","lik","","coff","","","and","bananas"</center>
460	!! - Used with both __delimiter__ = " e" and __merge__ = .true. :
461	!! <center>"I","lik","coff","and","bananas"</center>
462	!! @warning
463	!! The method does not trim or adjust the input string. Consequently, it can
464	!! add several empty words at the end of the list if the string is not well
465	!! defined.
466	!! @warning To avoid such problems, consider using TRIM() and ADJUSTL()
467	!! function on __str__ actual argument when calling this subroutine.
468	OBJECT(words), INTENT(inout), TARGET :: this
469	!! A words object to extend
470	CHARACTER(len=*), INTENT(in) :: str
471	!! A string to split in words
472	CHARACTER(len=*), INTENT(in), OPTIONAL :: delimiter
473	!! An optional string with the words delimiters (default to blank space).
474	LOGICAL, INTENT(in), OPTIONAL :: merge
475	!! An optional boolean control flag that instructs the method
476	!! wether to merge or not successive delimiters (default to .false.)
477	LOGICAL, INTENT(in), OPTIONAL :: protect
478	!! An optional boolean flag with .true. to indicate that
479	!! delimiter characters between quotes are protected
480	! - LOCAL
481	INTEGER :: sl,p,i,j,stat
482	LOGICAL :: zmerge,zprotect,indq,insq,outer
483	CHARACTER(len=:), ALLOCATABLE :: seps
484	CHARACTER(len=:), ALLOCATABLE :: curw
485	CHARACTER(len=1), PARAMETER :: sq = CHAR(39) ! single quote ascii code
486	CHARACTER(len=1), PARAMETER :: dq = CHAR(34) ! double quotes ascii code
487	stat=0 ; p=1 ; indq = .false. ; insq = .false.
488	seps = ' '
489	zmerge = .false. ; IF (PRESENT(merge)) zmerge = merge
490	zprotect = .true. ; IF (PRESENT(protect)) zprotect = protect
491	IF (PRESENT(delimiter)) THEN
492	IF (LEN(delimiter) > 0) seps = delimiter
493	ENDIF
494	sl = LEN(str) ; IF (sl == 0) RETURN
495	outer = (INDEX(str,sq) == 1 .AND. INDEX(str,sq,.true.) == LEN(str)) &
496	.OR.(INDEX(str,dq) == 1 .AND. INDEX(str,dq,.true.) == LEN(str))
497	! no delimiter found or (have outer quotes and should protect)
498	IF (SCAN(str,seps) == 0.OR.(outer.AND.zprotect)) THEN
499	CALL words_append(this,remove_quotes(str))
500	RETURN
501	ENDIF
502	! We have to loop...
503	i = 1 ; curw=''
504	DO
505	IF (i > sl) EXIT
506	p = SCAN(str(i:),seps) ! position du delimiteur
507	IF (p == 0) THEN
508	! a gerer
509	curw = curw//TRIM(str(i:))
510	CALL words_append(this,TRIM(str(i:))) ; EXIT
511	curw=''
512	ELSE
513	IF (zprotect) THEN
514	j=i
515	! starting state
516	DO WHILE(j<i+p)
517	IF (str(j:j) == sq.AND. .NOT.indq) insq = .NOT.insq
518	IF (str(j:j) == dq.AND. .NOT.insq) indq = .NOT.indq
519	j = j+1
520	ENDDO
521	IF ((insq.AND.INDEX(str(j:),"'")/=0) .OR. &
522	(indq.AND.INDEX(str(j:),'"')/=0)) THEN
523	curw=curw//str(i:i+p-1)
524	i=i+p ; CYCLE
525	ENDIF
526	ENDIF
527	IF (p == 1) THEN
528	IF (.NOT.zmerge) THEN
529	curw=''
530	CALL words_append(this,curw)
531	ENDIF
532	i = i + 1 ; CYCLE
533	ELSE
534	curw=curw//str(i:i+p-2)
535	CALL words_append(this,curw)
536	curw = ''
537	i = i + p
538	ENDIF
539	ENDIF
540	ENDDO
541	DEALLOCATE(curw) ; DEALLOCATE(seps)
542	!IF (zprotect) THEN
543	! ! catching unbalanced quotes
544	! IF (insq .OR. indq) &
545	! WRITE(*,'(a)') "extends:warning: unbalanced quotes"
546	!ENDIF
547	RETURN
548	END SUBROUTINE ws_extend_str
549
550	FUNCTION ws_get_ptr(this,idx) RESULT(pted)
551	!! Get the pointer of the word object at given index
552	!!
553	!! The method returns the pointer of the word object at the given index.
554	!! If index is out of range a null poitner is returned.
555	OBJECT(words), INTENT(in) :: this
556	!! A words object
557	INTEGER, INTENT(in) :: idx
558	!! An integer with the index of the desired object in __this__
559	TYPE(word), POINTER :: pted
560	!! A pointer to the selected word object.
561	INTEGER :: i
562	pted => null()
563	IF (idx < 1 .OR. idx > words_length(this)) THEN
564	RETURN
565	ENDIF
566	IF (idx > (this%nw+1)/2) THEN
567	pted => this%tail
568	DO i=1,this%nw - idx ; pted => pted%prev ; ENDDO
569	ELSE
570	pted => this%head
571	DO i=1,idx-1 ; pted => pted%next ; ENDDO
572	ENDIF
573	RETURN
574	END FUNCTION ws_get_ptr
575
576	FUNCTION words_length(this) RESULT(res)
577	!! Get the size of the words object.
578	!!
579	!! The method returns the number of words stored in the given list of words.
580	OBJECT(words), INTENT(in) :: this !! A words object.
581	INTEGER :: res !! The number of words in the object.
582	res = this%nw
583	RETURN
584	END FUNCTION words_length
585
586	SUBROUTINE words_insert(this, idx, value)
587	!! Insert a word before given index in a list of words.
588	!!
589	!! The method inserts a new word before the given index in the list of words. If the given index is out
590	!! of range, the method prepends/appends the object based on the index value.
591	OBJECT(words), INTENT(inout) :: this
592	!! A words object.
593	INTEGER, INTENT(in) :: idx
594	!! An integer with the index of an object in the list. The new object will be inserted before that index.
595	CHARACTER(len=*), INTENT(in) :: value
596	!! A string with the word to insert in the list.
597	TYPE(word), POINTER :: welt,nx,pv
598	INTEGER :: i
599	welt => null() ; nx => null() ; pv => null()
600	IF (this%nw == 0) THEN
601	CALL ini_word(this,value)
602	ELSE IF (idx > this%nw) THEN
603	this%nw = this%nw + 1
604	welt => this%tail
605	allocate(this%tail)
606	ASSIGN_DTSTR(value,this%tail%value)
607	this%tail%prev => welt
608	this%tail%prev%next => this%tail
609	ELSE IF (idx <= 1) THEN
610	this%nw = this%nw + 1
611	welt => this%head
612	allocate(this%head)
613	ASSIGN_DTSTR(value,this%head%value)
614	this%head%next => welt
615	this%head%next%prev => this%head
616	ELSE
617	IF (idx > (this%nw+1)/2) THEN
618	nx => this%tail
619	DO i=1, this%nw - idx ; nx => nx%prev ; ENDDO
620	ELSE
621	nx => this%head
622	DO i=1, idx-1 ; nx => nx%next ; ENDDO
623	ENDIF
624	pv => nx%prev
625	allocate(welt)
626	ASSIGN_DTSTR(value,welt%value)
627	welt%prev => pv ; welt%next => nx
628	pv%next => welt ; nx%prev => welt
629	this%nw = this%nw + 1
630	ENDIF
631	RETURN
632	END SUBROUTINE words_insert
633
634	SUBROUTINE words_append(this,value)
635	!! Append a word to the list of word
636	!!
637	!! The method appends a word to the list of word. This is a convinient wrapper to
638	!! [[string_op(module)::words_insert(subroutine)]] to add a new word at the beginning of the list.
639	OBJECT(words), INTENT(inout) :: this !! A words object
640	CHARACTER(len=*), INTENT(in) :: value !! A string to append
641	!CALL words_insert(this,this%nw+1,value)
642	type(word), pointer :: np
643
644	call words_insert(this,this%nw+1,value)
645
646	!! If the list is empty
647	!if (this%nw == 0) then
648	! call ini_word(this, value)
649	! return
650	!end if
651	!! Add new element to the end
652	!this%nw = this%nw + 1
653	!np => this%tail
654	!allocate(this%tail)
655	!this%tail%value = TRIM(value)
656	!this%tail%prev => np
657	!this%tail%prev%next => this%tail
658	RETURN
659	END SUBROUTINE words_append
660
661	SUBROUTINE words_prepend(this,value)
662	!! Prepend a word to the list of word
663	!!
664	!! The method prepends a word to the list of word. This is a convinient wrapper to
665	!! [[string_op(module)::words_insert(subroutine)]] to add a new word at the end of the list.
666	OBJECT(words), INTENT(inout) :: this !! A words object
667	CHARACTER(len=*), INTENT(in) :: value !! A string to prepend
668	CALL words_insert(this,0,value)
669	RETURN
670	END SUBROUTINE words_prepend
671
672	FUNCTION words_get(this,idx,case) RESULT (res)
673	!! Get the word's value at given index
674	!!
675	!! The method attempts to get the word's value at the given index. If index is out of range
676	!! an empty string is returned.
677	!! @note
678	!! The returned string is always trimmed.
679	OBJECT(words), INTENT(in) :: this
680	!! A words object reference
681	INTEGER, INTENT(in) :: idx
682	!! An integer with the index of a word in the list
683	CHARACTER(len=5), INTENT(in), OPTIONAL :: case
684	!! An optional string with either 'upper' or 'lower' to get the value converted in the relevant case
685	CHARACTER(len=:), ALLOCATABLE :: res
686	!! The value of the word stored at given index in the list of words
687	TYPE(word), POINTER :: cur
688	cur => ws_get_ptr(this,idx)
689	IF (.not.associated(cur)) THEN
690	res = '' ; RETURN
691	ENDIF
692	IF (PRESENT(case)) THEN
693	IF (case == "upper") res = to_upper(cur%value)
694	IF (case == "lower") res = to_lower(cur%value)
695	ELSE
696	res = TRIM(cur%value)
697	ENDIF
698	RETURN
699	END FUNCTION words_get
700
701	SUBROUTINE words_set(this,idx,value)
702	!! Set a new value to a word object in the list of words at given index
703	!!
704	!! The method sets a new word at given index. If index is out of range, the method simply does nothing.
705	OBJECT(words), INTENT(inout) :: this !! A words object
706	INTEGER, INTENT(in) :: idx !! An integer with the index of the word object to modify in the list
707	CHARACTER(len=*), INTENT(in) :: value !! A string with the new value to set
708	TYPE(word), POINTER :: cur
709	cur => ws_get_ptr(this,idx)
710	IF (.NOT.ASSOCIATED(cur)) RETURN
711	cur%value = value
712	END SUBROUTINE words_set
713
714	FUNCTION words_get_max_width(this) RESULT(res)
715	!! Get the longest word's width in the words object
716	!!
717	!! The method computes and returns the longest (trimmed) word's width in the words object.
718	OBJECT(words), INTENT(in) :: this !! A words object
719	INTEGER :: res !! An integer with the maximum width (0 if the list is empty)
720	TYPE(word), POINTER :: cur
721	res = 0
722	IF (this%nw == 0) RETURN
723	cur => this%head ; res = word_length(cur)
724	DO WHILE(ASSOCIATED(cur%next))
725	cur => cur%next
726	IF (word_length(cur) > res) res = word_length(cur)
727	ENDDO
728	RETURN
729	END FUNCTION words_get_max_width
730
731	FUNCTION words_get_total_width(this) RESULT(width)
732	!! Get the total width of all words stored in the list of words
733	!!
734	!! The method computes and returns the total width of all words stored in
735	!! the list of words.
736	!! @note
737	!! Total width is computed using strings::word_length so it only takes
738	!! into account trimmed words (without trailing blanks)
739	!! @note
740	!! If csi codes have been added to words elements they are counted in the width.
741	OBJECT(words), INTENT(in) :: this !! A words object
742	INTEGER :: width !! Total length of the list of words
743	TYPE(word), POINTER :: cur
744	width = 0
745	IF (this%nw == 0) RETURN
746	cur => this%head ; width = word_length(cur)
747	DO WHILE(ASSOCIATED(cur%next))
748	cur => cur%next
749	width = width + word_length(cur)
750	ENDDO
751	cur => null()
752	RETURN
753	END FUNCTION words_get_total_width
754
755	SUBROUTINE words_reverse(this)
756	!! Reverse the list of words in-place
757	OBJECT(words), INTENT(inout) :: this
758	!! A words object to reverse
759	TYPE(word), POINTER :: loop,iwc,iwp
760	IF (this%nw <= 1) RETURN
761	loop => this%head ; iwc=> this%head ; iwp=> null()
762	DO WHILE(ASSOCIATED(loop%next))
763	loop => loop%next
764	iwp => iwc%prev ; iwc%prev => iwc%next ; iwc%next => iwp
765	iwc => loop
766	ENDDO
767	iwp=>this%tail%prev ; this%tail%prev=>this%tail%next ; this%tail%next=>iwp
768	iwc => this%head ; this%head => this%tail ; this%tail => iwc
769	loop => null() ; iwc => null() ; iwp => null()
770	RETURN
771	END SUBROUTINE words_reverse
772
773	FUNCTION words_reversed(this) RESULT(res)
774	!! Get a reversed copy of the list of words
775	OBJECT(words), INTENT(in) :: this
776	!! A words object to reverse
777	TYPE(words) :: res
778	!! A reversed copy of the input list of words
779	TYPE(word),POINTER :: cur
780	IF(this%nw == 0) RETURN
781	cur => this%tail
782	DO WHILE(ASSOCIATED(cur))
783	CALL words_append(res,cur%value)
784	IF (ASSOCIATED(cur,this%iter)) res%iter => res%tail
785	cur => cur%prev
786	ENDDO
787	cur => null()
788	RETURN
789	END FUNCTION words_reversed
790
791	SUBROUTINE words_dump(this,lun)
792	!! Dump the list of words
793	!!
794	!! The method dumps on the given logical unit the elements of the list one by line.
795	OBJECT(words), INTENT(in) :: this
796	!! A words object to dump
797	INTEGER, INTENT(in), OPTIONAL :: lun
798	!! An optional integer with the printing logical unit. If not given, the list is dumped on
799	!! standard output stream.
800	TYPE(word), POINTER :: cur
801	INTEGER :: lu
802	IF (this%nw == 0) RETURN
803	lu=6 ; IF (PRESENT(lun)) lu = lun
804	cur => this%head
805	DO WHILE(ASSOCIATED(cur))
806	WRITE(lu,'(a)') TRIM(cur%value)
807	cur => cur%next
808	ENDDO
809	cur => null()
810	RETURN
811	END SUBROUTINE words_dump
812
813	FUNCTION words_to_string(this, delimiter,protect) RESULT(str)
814	!! Convert the list of words into a string
815	!!
816	!! The method converts the list of words into a string. In output, string is always
817	!! allocated even if the list is empty.
818	!!
819	!! If `protect` is set to .true. (default to .false.), each word is enclose between
820	!! double quotes. This option can be used to perform operation on the string before
821	!! setting it back as values of the list of words.
822	OBJECT(words), INTENT(in) :: this
823	!! A words object
824	CHARACTER(len=*), INTENT(in), OPTIONAL :: delimiter
825	!! An optional string used as delimiter between each words
826	LOGICAL, INTENT(in), OPTIONAL :: protect
827	!! Optional control flag with .true. to protect each word during concatentation.
828	CHARACTER(len=:), ALLOCATABLE :: str
829	!! An allocatable string with the list of words joined by the given delimiter (if any)
830	TYPE(word), POINTER :: cur
831	LOGICAL :: zprotect
832	zprotect = .false. ; IF (PRESENT(protect)) zprotect = protect
833	str = ''
834	IF (this%nw == 0) RETURN
835	cur => this%head
836	DO WHILE(ASSOCIATED(cur))
837	IF (zprotect) THEN
838	str=str//'"'//TRIM(cur%value)//'"'
839	ELSE
840	str=str//TRIM(cur%value)
841	ENDIF
842	IF (PRESENT(delimiter).AND..NOT.ASSOCIATED(cur,this%tail)) &
843	str=str//delimiter
844	cur => cur%next
845	ENDDO
846	RETURN
847	END FUNCTION words_to_string
848
849	FUNCTION words_to_vector(this,ret) RESULT(ok)
850	!! Convert the list of words into a vector of strings
851	!!
852	!! The method attempts to convert the list of words in a vector of strings.
853	!! If _this_ list of words is empty, the output vector is allocated with 0 elements and the method returns
854	!! .false., otherwise it returns .true.
855	!! @note
856	!! If elements in __this__ words object are wider than [[string_op(module):st_slen(variable)]], output
857	!! values will be truncated.
858	OBJECT(words), INTENT(in) :: this
859	!! A words object reference
860	CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: ret
861	!! An allocatable vector of assumed length string with the words of __this__
862	LOGICAL :: ok
863	!! Return status.
864	INTEGER :: l,mw
865	TYPE(word), POINTER :: iw
866	ok = .true.
867	l = words_length(this)
868	IF (l == 0) THEN
869	ALLOCATE(ret(0))
870	ok = .false.
871	RETURN
872	ENDIF
873	ALLOCATE(ret(l)) ; mw = LEN(ret(l))
874	ret(1:l) = ' ' ! really needed ?
875	iw => this%head ; l=1
876	DO WHILE(ASSOCIATED(iw))
877	ret(l) = TRIM(iw%value) ; l=l+1 ; iw => iw%next
878	ENDDO
879	END FUNCTION words_to_vector
880
881	FUNCTION words_pop(this,idx,move_forward) RESULT(value)
882	!! Pop a word in the list of words
883	!!
884	!! The method removes the word of the list at given index and returns it. If no index is given,
885	!! last word of the list is removed.
886	!!
887	!! If the index is out of range, the method does nothing and returns an empty string.
888	!!
889	!! By default, if the iterator is located on the item to be removed, it is moved backward before
890	!! deletion occurs. If __move\_forward__ is set to .true., the iterator is moved forward.
891	OBJECT(words), INTENT(inout) :: this
892	!! A words object
893	INTEGER, INTENT(in), OPTIONAL :: idx
894	!! Optional index of the word to delete
895	LOGICAL, INTENT(in), OPTIONAL :: move_forward
896	!! Move the iterator forward if needed. By default the iterator is moved backward.
897	CHARACTER(len=:), ALLOCATABLE :: value
898	!! The word's value at given index
899	LOGICAL :: zforward
900	INTEGER :: zidx
901	TYPE(word), POINTER :: cur
902	zidx=words_length(this) ; IF (PRESENT(idx)) zidx = idx
903	zforward = .false. ; IF (PRESENT(move_forward)) zforward = move_forward
904	cur => ws_get_ptr(this,zidx)
905	IF (.NOT.ASSOCIATED(cur)) THEN
906	value = '' ; RETURN
907	ELSE IF (ASSOCIATED(cur,this%iter)) THEN
908	IF (zforward) THEN
909	CALL words_next(this)
910	ELSE
911	CALL words_previous(this)
912	ENDIF
913	ENDIF
914	value = TRIM(cur%value)
915	CALL disconnect_word(cur)
916	DEALLOCATE(cur)
917	this%nw = this%nw - 1
918	RETURN
919	END FUNCTION words_pop
920
921	SUBROUTINE words_remove(this,idx,move_forward)
922	!! Remove the word of the list at given index
923	!!
924	!! The method removes the word of the list at given index. If no index is given, last word
925	!! of the list is removed.
926	!!
927	!! If the index is out of range, the method does nothing.
928	!!
929	!! By default, if the iterator is located on the item to be removed, it is moved backward before
930	!! deletion occurs. If __move\_forward__ is set to .true., the iterator is moved forward.
931	OBJECT(words), INTENT(inout) :: this
932	!! A words object
933	INTEGER, INTENT(in), OPTIONAL :: idx
934	!! Index of the word to delete
935	LOGICAL, INTENT(in), OPTIONAL :: move_forward
936	!! Move the iterator forward if needed. By default the iterator is moved backward.
937	LOGICAL :: zforward
938	INTEGER :: zidx
939	TYPE(word), POINTER :: cur
940	zidx=words_length(this) ; IF(PRESENT(idx)) zidx = idx
941	zforward = .false. ; IF (PRESENT(move_forward)) zforward = move_forward
942	cur => ws_get_ptr(this,idx)
943	IF (.NOT.ASSOCIATED(cur)) THEN
944	RETURN
945	ELSE IF (ASSOCIATED(cur,this%iter)) THEN
946	IF (zforward) THEN
947	CALL words_next(this)
948	ELSE
949	CALL words_previous(this)
950	ENDIF
951	ENDIF
952	CALL disconnect_word(cur)
953	DEALLOCATE(cur)
954	this%nw = this%nw - 1
955	RETURN
956	END SUBROUTINE words_remove
957
958	SUBROUTINE words_next(this)
959	!! Go to the next word in the list
960	OBJECT(words), INTENT(inout) :: this !! A words object
961	IF (ASSOCIATED(this%iter)) this%iter => this%iter%next
962	END SUBROUTINE words_next
963
964	SUBROUTINE words_previous(this)
965	!! Go to the previous word in the list
966	OBJECT(words), INTENT(inout) :: this !! A words object
967	IF (ASSOCIATED(this%iter)) this%iter => this%iter%prev
968	END SUBROUTINE words_previous
969
970	FUNCTION words_valid(this) RESULT(ret)
971	!! Check if the current iterated word is valid
972	OBJECT(words), INTENT(in) :: this !! A words object
973	LOGICAL :: ret !! A logical flag with .true. if the current iterated word is valid
974	ret = associated(this%iter)
975	END FUNCTION words_valid
976
977	FUNCTION words_current(this) RESULT(wrd)
978	!! Get current word value
979	OBJECT(words), INTENT(in) :: this
980	!! A words object
981	CHARACTER(len=:), ALLOCATABLE :: wrd
982	!! A string with the value of the current word or __an unallocated string__ if current word
983	!! is not valid (see [[string_op(module):words_valid(function)]]).
984	IF (ASSOCIATED(this%iter)) THEN
985	wrd = this%iter%value
986	ENDIF
987	END FUNCTION words_current
988
989	SUBROUTINE words_reset(this,to_end)
990	!! Reset the iterator
991	!!
992	!! The method resets the iterator either at the beginning or at the end of the list of words
993	!! (if __to_end__ is set to .true.).
994	OBJECT(words), INTENT(inout) :: this !! A words object
995	LOGICAL, INTENT(in), OPTIONAL :: to_end !! An optional logical flag with .true. to reset the iterator at the end of the list
996	this%iter => this%head
997	IF (PRESENT(to_end)) THEN
998	IF (to_end) this%iter => this%tail
999	ENDIF
1000	END SUBROUTINE words_reset
1001
1002	! Fancy string methods
1003	! --------------------
1004
1005	FUNCTION tokenize(str,vector,delimiter,merge,protect) RESULT(ok)
1006	!! Tokenize a string.
1007	CHARACTER(len=*), INTENT(in) :: str
1008	!! A string to tokenize
1009	CHARACTER(len=st_slen), INTENT(out), DIMENSION(:), ALLOCATABLE :: vector
1010	!! An allocatable vector of strings with the tokens found. If string cannot be tokenized,
1011	!! the vector is __allocated to 0 elements__ and the method returns .false..
1012	CHARACTER(len=*), INTENT(in), OPTIONAL :: delimiter
1013	!! An optional string with the words delimiters. It is set to blank space by default.
1014	!! Note that each character is seen as a single delimiter.
1015	LOGICAL, INTENT(in), OPTIONAL :: merge
1016	!! An optional boolean control flag with .true. that instructs the method whether to
1017	!! merge or not successive delimiters. Default to .false.
1018	LOGICAL, INTENT(in), OPTIONAL :: protect
1019	!! An optional boolean flag with .true. to indicate that delimiter characters between
1020	!! quotes are protected. Default to .true.
1021	LOGICAL :: ok
1022	!! Return status (.true. on success).
1023	CHARACTER(len=:), ALLOCATABLE :: seps
1024	TYPE(words) :: tmp
1025	LOGICAL :: zmerge,zprotect
1026	TYPE(word), POINTER :: wrd
1027	integer :: i,nw
1028	ok = .true.
1029	zmerge = .false. ; zprotect = .true. ; seps = ' '
1030	IF (PRESENT(merge)) zmerge = merge
1031	IF (PRESENT(protect)) zprotect = protect
1032	IF (PRESENT(delimiter)) THEN
1033	IF (LEN(delimiter) > 0 ) seps = delimiter
1034	ENDIF
1035	call words_extend(tmp,str,seps,zmerge,zprotect)
1036	nw = tmp%nw
1037	i = 1
1038	ALLOCATE(vector(tmp%nw))
1039	IF (nw > 0) THEN
1040	wrd => tmp%head
1041	DO WHILE(ASSOCIATED(wrd))
1042	vector(i) = TRIM(wrd%value)
1043	wrd => wrd%next
1044	i = i+1
1045	ENDDO
1046	ELSE
1047	ok = .false.
1048	ENDIF
1049	call words_clear(tmp)
1050	RETURN
1051	END FUNCTION tokenize
1052
1053	FUNCTION remove_quotes(str) RESULT(ostr)
1054	!! Strips outer quotes from string
1055	!!
1056	!! The function removes only external quotes from the input string
1057	!! and returns the result in an allocatable string.
1058	!! Quotes are removed only if they are the first and last non blank
1059	!! characters. Either double and single quotes are stripped without distinction.
1060	!! The output string is trimmed from leading and trailing blank spaces (after quotes removal !)
1061	CHARACTER(len=*), INTENT(in) :: str !! A string to check
1062	CHARACTER(len=:), ALLOCATABLE :: ostr !! A string without external quotes (if any).
1063	CHARACTER(len=1), PARAMETER :: sq=CHAR(39), dq=CHAR(34)
1064	CHARACTER(len=2), PARAMETER :: dsq=CHAR(39)//CHAR(34)
1065	INTEGER :: i, j
1066	IF (LEN_TRIM(str) == 0) RETURN
1067	ostr = TRIM(ADJUSTL(str))
1068	i = SCAN(ostr,sq//dq) ; j = SCAN(ostr,sq//dq,.true.)
1069	IF (i == j) RETURN
1070	IF (i /= 1) i = 0
1071	IF (j /= LEN(ostr)) j = LEN(ostr)+1
1072	ostr = TRIM(ostr(i+1:j-1))
1073	RETURN
1074	END FUNCTION remove_quotes
1075
1076	FUNCTION string_is(str) RESULT(ret)
1077	!! Check if string represents an intrinsic type
1078	!!
1079	!! The method checks if the given string represents an intrinsic type. Both logical and complex type
1080	!! are checked in a strict way :
1081	!!
1082	!! - A string is a logical if it is one of the following value: __.false.__, __.true.__, __F__, __T__.
1083	!! - A string is potentially a complex if it has the following format: __(\\\,\\\)__ where
1084	!! __\\\*__ is checked to see wether it is numerical or not.
1085	!!
1086	!! Valid numerical values can take the following forms:
1087	!! ```
1088	!! [0-9]
1089	!! [0-9].?[0-9]?([ed][+-]?[0-9]+)?
1090	!! ```
1091	!! Obviously if returned value is greater than 3, the string can be converted in
1092	!! floating point value.
1093	!!
1094	!! Empty input string is simply considered to be of string type !
1095	CHARACTER(len=*), INTENT(in) :: str
1096	!! A string to check
1097	INTEGER :: ret
1098	!! An integer with the intrinsic type related to the string.
1099	!!
1100	!! Types are one of the following parameters
1101	!!
1102	!! - [[string_op(module):st_string(variable)]] (1) for string
1103	!! - [[string_op(module):st_logical(variable)]] (2) for logical
1104	!! - [[string_op(module):st_complex(variable)]] (3) for complex
1105	!! - [[string_op(module):st_integer(variable)]] (4) for integer
1106	!! - [[string_op(module):st_real(variable)]] (5) for floating point value
1107	CHARACTER(len=:), ALLOCATABLE :: zs,zzs
1108	INTEGER :: j,l
1109	ret = 1 ; IF (LEN_TRIM(str) == 0) RETURN
1110	zs = to_lower(TRIM(ADJUSTL(str))) ; j = INDEX(zs,',') ; l = len(zs)
1111	IF (zs(1:1)=='('.AND.zs(l:l) == ')'.AND.j==INDEX(zs,',')) THEN
1112	IF (j == 2 .OR. j == l-1) RETURN
1113	zzs = TRIM(ADJUSTL(zs(2:j-1))) ; IF (what_(zzs) < 3) RETURN
1114	zzs = TRIM(ADJUSTL(zs(j+1:l-1))) ; ret = what_(zzs)
1115	IF (ret > 3) THEN ; ret = 3 ; ELSE ; ret = 1 ; ENDIF
1116	ELSE
1117	ret = what_(zs)
1118	ENDIF
1119	CONTAINS
1120	FUNCTION what_(s) RESULT(is)
1121	!! Check if the given string is numerical, logical or a simple string
1122	!! @note
1123	!! Input string should be in lower case, otherwise, the method will give a a wrong result.
1124	!! @warning
1125	!! The test performed for logical checking is quite strict : A string is considered as logical
1126	!! if and only if it is one of the following values : __.false.__, __.true.__, __F__, __T__.
1127	CHARACTER(len=*), INTENT(in) :: s
1128	!! A string to check
1129	INTEGER :: is
1130	!! An integer with : __1__ for string, __2__ for logical, __4__ for integer and __5__ for real
1131	LOGICAL :: dec,fdot,fexp
1132	INTEGER :: i
1133	CHARACTER(len=24), PARAMETER :: aset='abcfghijklmnopqrstuvwxyz'
1134	CHARACTER(len=10), PARAMETER :: iset='1234567890'
1135	CHARACTER(len=2), PARAMETER :: dset='ed'
1136	CHARACTER(len=2), PARAMETER :: sset='+-'
1137	CHARACTER(len=7), PARAMETER :: slog(4) = (/'.true. ','.false.',&
1138	't ','f '/)
1139	is = -1 ; dec = .false. ; fdot = dec ; fexp = fdot
1140	DO i = 1,LEN(s)
1141	IF (i == 1) THEN
1142	! string does not start by [+-\.\d]
1143	IF (VERIFY(s(i:i),'.'//iset//sset) /= 0) THEN
1144	is = 1 ; EXIT
1145	ENDIF
1146	! update control flag for decimal part
1147	dec = s(i:i) == '.' ; fdot = dec
1148	ELSE
1149	! check if char is in [a-z]
1150	IF(VERIFY(s(i:i),aset) == 0) THEN
1151	dec=.false. ; is = 1 ; EXIT
1152	ELSE IF (s(i:i) == '.') THEN
1153	! check for dot in decimal/exponent part (==> not a number
1154	IF (fdot.OR.fexp) THEN
1155	dec = .false. ; is = 1 ; EXIT
1156	ENDIF
1157	ELSE IF (VERIFY(s(i:i),dset)==0) THEN
1158	IF (fexp) THEN
1159	dec = .false. ; is = 1 ; EXIT
1160	ENDIF
1161	ELSE IF (VERIFY(s(i:i),sset) == 0) THEN
1162	IF (VERIFY(s(i-1:i-1),dset) /= 0) THEN
1163	dec = .false. ; is = 1 ; EXIT
1164	ENDIF
1165	ENDIF
1166	fdot = (fdot .OR. s(i:i) == '.')
1167	fexp = (fexp .OR. VERIFY(s(i:i), dset) == 0)
1168	ENDIF
1169	ENDDO
1170	! it is a string
1171	IF (is == 1) THEN
1172	! but have the format of a logical
1173	IF (any(slog == s)) is = 2
1174	ELSE
1175	IF ((fexp.AND.SCAN(s(LEN(s):LEN(s)),dset) /= 0)) THEN
1176	is = 1
1177	ELSE
1178	is = 4
1179	IF (fdot.OR.fexp) is = 5
1180	ENDIF
1181	ENDIF
1182	END FUNCTION what_
1183	END FUNCTION string_is
1184
1185	FUNCTION format_string(str,idt1,idto) RESULT(output)
1186	!! Format the given string
1187	!!
1188	!! This function only replaces all '\\n' escape sequence in the given string by NEW_LINE() character.
1189	!! The output string is eventually indented if optional arguments are set.
1190	!! @warning
1191	!! __idto__ is relative to __idt1__ !
1192	CHARACTER(len=*), INTENT(in) :: str !! The string to format
1193	INTEGER, INTENT(in), OPTIONAL :: idt1, & !! An optional integer with the indentation level of the first output line (default to 0)
1194	idto !! An optional integer with the indentation level of all other output lines (default to 0)
1195	CHARACTER(len=:), ALLOCATABLE :: output !! An allocatable string with the output formatted string.
1196	! - LOCAL
1197	INTEGER :: i,c,ti,mx
1198	CHARACTER(len=:), ALLOCATABLE :: idts
1199	IF (LEN_TRIM(str) == 0) THEN
1200	ALLOCATE(output,source='') ; RETURN
1201	ENDIF
1202	i=0 ; IF (PRESENT(idt1)) i = MAX(i,idt1)
1203	ALLOCATE(CHARACTER(len=i) :: output)
1204	IF (i > 0) output(1:i) = CHAR(32)
1205	! i0 is relative to i1 and must be >= 0
1206	IF (PRESENT(idto)) i = MAX(i+idto,0)
1207	ALLOCATE(CHARACTER(len=i+1) :: idts)
1208	idts(1:1) = NEW_LINE('A') ; IF (i>1) idts(2:) = CHAR(32)
1209	! Builds output string
1210	c=1 ; mx = LEN_TRIM(str)
1211	i = INDEX(str(c:),'\n') ; ti = c+i-1
1212	IF (i == 0) THEN
1213	output=output//TRIM(str(ti+1:mx))
1214	ELSE
1215	output=output//TRIM(str(c:ti-1)) ; c=ti+2
1216	DO
1217	i = INDEX(str(c:),"\n") ; ti = c+i-1
1218	IF (i == 0) THEN
1219	output=output//TRIM(str(ti+1:mx)) ; c = mx+1
1220	ELSE
1221	output=output//idts//str(c:ti-1) ; c = ti+2
1222	ENDIF
1223	IF (c > mx) EXIT
1224	ENDDO
1225	ENDIF
1226	! print a newline if we have \n at the end of the string
1227	IF (INDEX(TRIM(str),'\n',.true.) == mx-1.AND.TRIM(str) /= '\n') &
1228	output=output//idts(1:1)
1229	END FUNCTION format_string
1230
1231	FUNCTION format_paragraph(str,width,idt1,idto) RESULT(output)
1232	!! Split and format a string over several lines
1233	!!
1234	!! The function splits an input string in words so output lines fit (almost) in __width__ characters.
1235	!! The method handles indentation level (defined as leading blank spaces). It also accounts for known
1236	!! csi (see [[string_op(module):attributes(variable)]]).
1237	!! @note
1238	!! Words are considered indivisible and thus output lines can sometimes exceed the maximum width if
1239	!! there is not enough space to put a word (with the associated indentation if given). The default
1240	!! behavior in that case is to print the word in a new line (with the correct leading blank spaces).
1241	!! @warning
1242	!! If __width__, __idt1__ and/or __idto__ have inconsistent values (e.g. __width__ <= __idt1__), the
1243	!! method still computes the paragraph, but each words will be set on a new line with the appropriate
1244	!! indentation.
1245	CHARACTER(len=*), INTENT(in) :: str !! string with the content to split
1246	INTEGER, INTENT(in) :: width !! An positive integer with the maximum width of a line
1247	INTEGER, INTENT(in), OPTIONAL :: idt1 !! An optional integer with the indentation level of the first output line
1248	INTEGER, INTENT(in), OPTIONAL :: idto !! An optional integer with the indentation level of the other output lines
1249	CHARACTER(len=:), ALLOCATABLE :: output !! An allocatable string with the output content
1250	CHARACTER(len=:), ALLOCATABLE :: idts,zs
1251	INTEGER :: l1,lo,zmx,zw,cc,j,jj,l
1252	zw = abs(width) ; zs = strip_newline(str)
1253	zmx = LEN_TRIM(zs)
1254	IF (zmx == 0) THEN
1255	ALLOCATE(output,source='') ; RETURN
1256	ENDIF
1257	l1=0 ; IF (PRESENT(idt1)) l1 = MAX(l1,idt1)
1258	ALLOCATE(CHARACTER(len=l1) :: output)
1259	IF (l1 > 0) output(1:l1) = CHAR(32)
1260	lo=l1 ; IF (PRESENT(idto)) lo = MAX(l1+idto,0)
1261	ALLOCATE(CHARACTER(len=lo+1) :: idts)
1262	idts(1:1) = NEW_LINE('A') ; IF (lo>=1) idts(2:len(idts)) = CHAR(32)
1263	! Prints a message if user is just stupid...
1264	IF (lo+1 > zw .OR. l1+1 > zw) THEN
1265	output = str ; RETURN
1266	ENDIF
1267	! check if can just return the string as is
1268	IF (zmx + l1 <= zw) THEN
1269	output=output//TRIM(zs) ; RETURN
1270	ENDIF
1271	j=1 ; jj=1+l1
1272	DO
1273	! Gets next blank in input string
1274	cc = INDEX(TRIM(zs(j:)),CHAR(32))
1275	! no more blank
1276	! Gets total length of csi between zs(j:j+cc-1)
1277	! this value will be substracted to each length test
1278	IF (cc == 0) THEN
1279	l = csis_length(zs(j:))
1280	IF (jj-1+LEN_TRIM(zs(j:))-l > zw) THEN
1281	output = output//idts
1282	ENDIF
1283	output=output//TRIM(zs(j:))
1284	EXIT ! we are at the last word : we must exit the infinite loop !
1285	ELSE
1286	l = csis_length(zs(j:j+cc-1))
1287	IF (cc+jj-1-l > zw) THEN
1288	output=output//idts//zs(j:j+cc-1) ; jj = lo+1+cc+1 - l
1289	ELSE
1290	output=output//zs(j:j+cc-1) ; jj = jj + cc - l
1291	ENDIF
1292	ENDIF
1293	j = j + cc
1294	ENDDO
1295	CONTAINS
1296	FUNCTION csis_length(str) RESULT(value)
1297	! - DUMMY
1298	CHARACTER(len=*), INTENT(in) :: str
1299	! - RESULT
1300	INTEGER :: value
1301	! - LOCAL
1302	INTEGER :: jc,iesc,im
1303	LOGICAL :: tcsi
1304	value = 0
1305	jc=1
1306	DO
1307	IF (jc>LEN(str)) EXIT
1308	! search for escape
1309	iesc = INDEX(str(jc:),CHAR(27))
1310	IF (iesc == 0) EXIT
1311	! search for m
1312	im = INDEX(str(jc+iesc:),"m")
1313	! no m in the string after ESC --> this could not be a csi
1314	IF (im == 0) EXIT
1315	! check if this is really a csi and updates length
1316	tcsi = is_csi(str(jc+iesc-1:jc+iesc+im-1))
1317	jc = jc + iesc
1318	IF (tcsi) THEN
1319	value=value+im+1
1320	jc=jc+im
1321	ENDIF
1322	ENDDO
1323	END FUNCTION csis_length
1324	END FUNCTION format_paragraph
1325
1326	FUNCTION strip_newline(str,rpl) RESULT(stripped)
1327	!! Replace newline escape sequences by spaces
1328	!!
1329	!! The function replaces newline (both '\\n' escape sequence and Fortran NEW_LINE() character) in the
1330	!! given string and returns the resulting string.
1331	CHARACTER(len=*), INTENT(in) :: str !! A string to process
1332	CHARACTER(len=1), INTENT(in), OPTIONAL :: rpl !! A optional single character used as substitution of escape sequences (blank space by default)
1333	CHARACTER(len=:), ALLOCATABLE :: stripped !! An allocatable string with all newline sequences replaced by blank space or __rpl__ if given
1334	CHARACTER(len=1) :: zrp
1335	INTEGER :: i, j, ns
1336	zrp = CHAR(32) ; IF(PRESENT(rpl)) zrp = rpl
1337	IF (str == NEW_LINE('A')) THEN
1338	stripped = zrp ; RETURN
1339	ENDIF
1340	ns = LEN_TRIM(str)
1341	IF (ns == 0) THEN
1342	ALLOCATE(stripped,source='') ; RETURN
1343	ENDIF
1344	ALLOCATE(CHARACTER(len=ns) :: stripped) ; stripped(1:ns) = CHAR(32)
1345	i=1 ; j=1
1346	DO
1347	IF (str(i:i) == NEW_LINE('A')) THEN
1348	stripped(j:j) = zrp
1349	ELSE IF (i < ns) THEN
1350	IF (str(i:i+1) == "\n") THEN
1351	stripped(j:j) = zrp ; i=i+1
1352	ELSE
1353	stripped(j:j) = str(i:i)
1354	ENDIF
1355	ELSE
1356	stripped(j:j) = str(i:i)
1357	ENDIF
1358	j=j+1 ; i=i+1
1359	IF (i > ns .OR. j > ns) EXIT
1360	ENDDO
1361	IF (j < ns) stripped = stripped(1:j)
1362	RETURN
1363	END FUNCTION strip_newline
1364
1365	FUNCTION str_length(str) RESULT(res)
1366	!! Get the length of the string object
1367	!!
1368	!! The method computes the length of the string. It differs from LEN intrinsic function as
1369	!! it does not account for extra-characters of csi codes.
1370	CHARACTER(len=*), INTENT(in) :: str !! String to process
1371	INTEGER :: res !! The actual length of string (i.e. does not account for csi codes)
1372	CHARACTER(len=:), ALLOCATABLE :: tmp
1373	res = 0
1374	IF (LEN(str) /= 0) THEN
1375	tmp = reset_csi(str)
1376	res = LEN(tmp)
1377	DEALLOCATE(tmp)
1378	ENDIF
1379	RETURN
1380	END FUNCTION str_length
1381
1382	FUNCTION to_lower(str1) RESULT(str)
1383	!! Convert the string in lower case
1384	!!
1385	!! The method converts the input string in lower case and accounts for
1386	!! possible csi codes in the string.
1387	CHARACTER(len=*), INTENT(in) :: str1 !! Input string to convert
1388	CHARACTER(len=:), ALLOCATABLE :: str !! A copy of the string in lower case
1389	INTEGER :: i,ic
1390	IF (LEN(str1) /= 0) THEN
1391	str = str1
1392	DO i = 1, len(str1)
1393	ic = ichar(str1(i:i))
1394	IF (ic >= 65 .AND. ic < 90) str(i:i) = char(ic + 32)
1395	ENDDO
1396	ELSE
1397	str=''
1398	ENDIF
1399	END FUNCTION to_lower
1400
1401	FUNCTION to_upper(str1) RESULT(str)
1402	!! Convert the string in upper case
1403	!!
1404	!! The method converts the input string in upper case and accounts for
1405	!! possible csi codes in the string.
1406	CHARACTER(len=*), INTENT(in) :: str1 !! Input string to convert
1407	CHARACTER(len=:), ALLOCATABLE :: str !! A copy of the string in upper case
1408	INTEGER :: j,i,ic,icsi,lcsi
1409	IF (LEN(str1) > 0) THEN
1410	str = str1
1411	i = 1
1412	DO
1413	IF (i > LEN(str)) EXIT
1414	icsi = str_index_of_csi(str(i:),lcsi)
1415	IF (icsi == 0) THEN
1416	! no more csi the end of string is upper case converted
1417	DO j=i,LEN(str)
1418	ic = ichar(str(j:j))
1419	IF (ic >= 97 .AND. ic < 122) str(j:j) = char(ic-32)
1420	ENDDO
1421	RETURN
1422	ELSE IF (icsi == 1) THEN
1423	i = i + lcsi
1424	ELSE IF (icsi > 1) THEN
1425	! csi is not the first word: we convert in upper case until its
1426	! position THEN copy the csi and get back in the loop
1427	DO j=i,i+icsi-2
1428	ic = ichar(str(j:j))
1429	IF (ic >= 97 .AND. ic < 122) str(j:j) = char(ic-32)
1430	ENDDO
1431	i = i + icsi + lcsi-1
1432	ENDIF
1433	ENDDO
1434	ELSE
1435	str=''
1436	ENDIF
1437	END FUNCTION to_upper
1438
1439	FUNCTION str_remove(string,substring,back,all) RESULT(str)
1440	!! Remove substring from current string
1441	!!
1442	!! The function removes the first occurence of __substring__ in __string__ or all
1443	!! its occurences if __all__ is explicitly set to .true..
1444	CHARACTER(len=*), INTENT(in) :: string !! A string to search in
1445	CHARACTER(len=*), INTENT(in) :: substring !! A string to search and removes from __string__
1446	LOGICAL, INTENT(in), OPTIONAL :: back, & !! An optional boolean flag with .true. to begin search at the end of the string
1447	all !! An optional boolean flag with .true. to remove all occurences of __substring__
1448	CHARACTER(len=:), ALLOCATABLE :: str !! An allocatable string with __substring__ occurence(s) removed
1449	LOGICAL :: zb,za
1450	INTEGER :: is,j,zboff
1451	str=''
1452	zb = .false. ; za = .false.
1453	IF (PRESENT(back)) zb = back
1454	IF (PRESENT(all)) za = all
1455	IF (za) zb=.false.
1456	zboff = 0 ; IF (zb) zboff = 1
1457	IF (LEN(string) == 0) RETURN
1458	j=1
1459	DO
1460	IF (j>LEN(string)) EXIT
1461	! search for substring
1462	is = INDEX(string(j:),substring,back=zb)
1463	IF (is == 0) THEN
1464	! substring is not found : we get the last part of the string and return
1465	str = str//string(j:) ; RETURN
1466	ELSE IF (is == 1) THEN
1467	j = j + LEN(substring)
1468	ELSE
1469	! substring is not at the begin of the string : saves the string
1470	str = str//string(j:j+is-2)
1471	j = j + is+LEN(substring)-1
1472	ENDIF
1473	! if we only want to str_remove ONE occurence we exit if substring
1474	! has been found
1475	IF (.NOT.(is==0.OR.za)) EXIT
1476	ENDDO
1477	IF (j <= LEN(string).AND..NOT.zb) str=str//string(j:)
1478	RETURN
1479	END FUNCTION str_remove
1480
1481	FUNCTION str_replace(string,old,new,back,all) RESULT(str)
1482	!! Replace substring from current string
1483	!!
1484	!! The function replaces the first occurence of __old__ in __string__ by
1485	!! __new__ or all its occurence(s) if __all__ is explicitly set to .true..
1486	CHARACTER(len=*), INTENT(in) :: string !! A string to search in
1487	CHARACTER(len=*), INTENT(in) :: old, & !! A string to search and replace
1488	new !! A string to substitute to __old__
1489	LOGICAL, INTENT(in), OPTIONAL :: back, & !! An optional boolean flag with .true. to begin search at the end of the string
1490	all !! An optional boolean flag with .true. to replace all occurences of __old__
1491	CHARACTER(len=:), ALLOCATABLE :: str !! An allocatable string with occurence(s) of __old__ replaced by __new__
1492	LOGICAL :: zb,za
1493	INTEGER :: is,j
1494	str=''
1495	zb = .false. ; za = .false.
1496	IF (PRESENT(back)) zb = back
1497	IF (PRESENT(all)) za = all
1498	IF (za) zb = .NOT.za
1499	IF (LEN(string) == 0) RETURN
1500	j=1
1501	DO
1502	IF (j>LEN(string)) EXIT
1503	! search for "old"
1504	is = INDEX(string(j:),old,back=zb)
1505	IF (is == 0) THEN
1506	! "old" is not found : we get the last part of the string and return
1507	str = str//string(j:) ; RETURN
1508	ELSE IF (is == 1) THEN
1509	str = str//new
1510	j = j + LEN(old)
1511	ELSE
1512	! "old" is not at the begin of the string : saves the string
1513	str = str//string(j:j+is-2)//new
1514	j = j + is + LEN(old) - 1
1515	ENDIF
1516	IF (.NOT.(is==0.OR.za)) EXIT
1517	ENDDO
1518	IF (j <= LEN(str)) str=str//string(j:)
1519	RETURN
1520	END FUNCTION str_replace
1521
1522	FUNCTION endswith(string,substring,icase) RESULT(ret)
1523	!! Check if string ends by substring
1524	CHARACTER(len=*), INTENT(in) :: string
1525	!! @param[in] string A string to check
1526	CHARACTER(len=*), INTENT(in) :: substring
1527	!! A string to search in __string__
1528	LOGICAL, INTENT(in), OPTIONAL :: icase
1529	!! An optional boolean flag with .true. to perform insensitive case search
1530	LOGICAL :: ret
1531	!! .true. if __string__ ends by __substring__, .false. otherwise.
1532	CHARACTER(len=:), ALLOCATABLE :: zthis,zstr
1533	INTEGER :: idx
1534	LOGICAL :: noc
1535	ret = .false.
1536	noc = .false. ; IF (PRESENT(icase)) noc = icase
1537	IF (LEN(string) == 0 .OR. LEN(substring) == 0) RETURN
1538	zthis = reset_csi(string) ; zstr=reset_csi(substring)
1539	IF (noc) THEN
1540	idx = INDEX(to_lower(zthis),to_lower(zstr),.true.)
1541	ELSE
1542	idx = INDEX(zthis,zstr,.true.)
1543	ENDIF
1544	IF (idx == 0.OR.idx+str_length(zstr)-1 /= str_length(zthis)) RETURN
1545	ret=.true.
1546	END FUNCTION endswith
1547
1548	FUNCTION startswith(string,substring,icase) RESULT(ret)
1549	!! Check if string starts by substring
1550	CHARACTER(len=*), INTENT(in) :: string
1551	!! A string to check
1552	CHARACTER(len=*), INTENT(in) :: substring
1553	!! A string to search in __string__
1554	LOGICAL, INTENT(in), OPTIONAL :: icase
1555	!! An optional boolean flag with .true. to perform insensitive case search
1556	LOGICAL :: ret
1557	!! .true. if __string__ starts by __substring__, .false. otherwise.
1558	CHARACTER(len=:), ALLOCATABLE :: zthis,zstr
1559	INTEGER :: idx
1560	LOGICAL :: noc
1561	ret = .false.
1562	noc = .false. ; IF (PRESENT(icase)) noc = icase
1563	IF (LEN(string) == 0 .OR. LEN(substring) == 0) RETURN
1564	zthis = reset_csi(string) ; zstr=reset_csi(substring)
1565	IF (noc) THEN
1566	idx = INDEX(to_lower(zthis),to_lower(zstr))
1567	ELSE
1568	idx = INDEX(zthis,zstr)
1569	ENDIF
1570	IF (idx /= 1) RETURN
1571	ret=.true.
1572	END FUNCTION startswith
1573
1574	! CSI related functions
1575	! ---------------------
1576
1577	FUNCTION add_csi(string,attrs) RESULT(str)
1578	!! Set csi attributes to the given string object
1579	!!
1580	!! The function adds csi (ANSI escape sequences) to the given string and
1581	!! returns a copy of it.
1582	CHARACTER(len=*), INTENT(in) :: string
1583	!! @param[in] string A string object reference
1584	INTEGER, INTENT(in), DIMENSION(:) :: attrs
1585	!! A vector of integers with the code to add. Each __attrs__ value should refers to one i
1586	!! of [[string_op(module):attributes(variable)]] values.
1587	CHARACTER(len=:), ALLOCATABLE :: str
1588	!! An allocatable string with new csi codes added.
1589	INTEGER :: j,iesc,im
1590	CHARACTER(len=:), ALLOCATABLE :: tmp,csi
1591	CHARACTER(len=4), PARAMETER :: rcsi = CHAR(27)//"[0m"
1592	str=''
1593	! 1) Check for input string
1594	IF (LEN(string) == 0) RETURN
1595	! 2) Removes last <ESC>[0m if any and initializes output string
1596	! we must remove only the last <ESC>[0m if any
1597	IF (INDEX(string,rcsi,.true.) == LEN(string)-3) THEN
1598	tmp = str_remove(string,rcsi,back=.true.)
1599	ELSE
1600	tmp = string
1601	ENDIF
1602	! 3) Add all the given csi preceded by <ESC>[0m at the beginning of the string
1603	! if it does not start by an ANSI sequence
1604	IF (INDEX(tmp,CHAR(27)//"[") /= 1) &
1605	tmp = str_add_to_csi(rcsi,attrs)//tmp
1606	! Loops on new string and updates csi codes
1607	j=1
1608	DO
1609	IF (j>LEN(tmp)) EXIT
1610	! search for escape
1611	iesc = INDEX(tmp(j:),CHAR(27))
1612	IF (iesc == 0) THEN
1613	! no more ESC : cat until end of input string and exit
1614	str = str//tmp(j:) ; EXIT
1615	ELSE IF (iesc > 1) THEN
1616	! ESC is not first char: copy until ESC
1617	str = str//tmp(j:j+iesc-2)
1618	ENDIF
1619	! search for m
1620	im = INDEX(tmp(j+iesc:),"m")
1621	! no m in the string after ESC --> copy string (INCLUDING ESC) and leave
1622	IF (im == 0) THEN
1623	str = str//tmp(j+iesc-1:)
1624	RETURN
1625	ENDIF
1626	csi = tmp(j+iesc-1:j+iesc+im-1)
1627	! we have a csi: we add new codes to it
1628	IF (is_csi(csi)) THEN
1629	csi = str_add_to_csi(csi,attrs)
1630	ENDIF
1631	str = str//csi
1632	j = j + iesc + im
1633	ENDDO
1634	IF (INDEX(str,rcsi,.true.) /= LEN(str)-3) str = str//rcsi
1635	RETURN
1636	END FUNCTION add_csi
1637
1638	FUNCTION del_csi(string,attrs) RESULT(str)
1639	!! Remove attributes to the given string
1640	!!
1641	!! The function removes list of csi (ANSI escape sequences) from the given
1642	!! string and returns a copy of it.
1643	CHARACTER(len=*), INTENT(in) :: string
1644	!! Input string
1645	INTEGER, INTENT(in), DIMENSION(:) :: attrs
1646	!! A vector of integers with the code to remove. Each __attrs__ value should
1647	!! refers to one of [[string_op(module):attributes(variable)]] values.
1648	CHARACTER(len=:), ALLOCATABLE :: str
1649	!! An allocatable string with csi codes from __list__ removed
1650	LOGICAL :: ok
1651	INTEGER :: j,iesc,im
1652	CHARACTER(len=:), ALLOCATABLE :: tmp,csi,csis
1653	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tks
1654	CHARACTER(len=4), PARAMETER :: rcsi = CHAR(27)//"[0m"
1655	str=''
1656	IF (LEN(string) == 0) RETURN
1657	! remove last <ESC>[0m if found at the end of the string
1658	IF (INDEX(string,rcsi,.true.) == LEN(string)-3) THEN
1659	tmp = str_remove(string,rcsi,back=.true.)
1660	ELSE
1661	tmp = string
1662	ENDIF
1663	! Loops on new string and updates csi codes
1664	j=1 ; csis=""
1665	DO
1666	IF (j>LEN(tmp)) EXIT
1667	! search for escape
1668	iesc = INDEX(tmp(j:),CHAR(27))
1669	IF (iesc == 0) THEN
1670	! no more ESC : cat until end of input string and exit
1671	str = str//tmp(j:) ; EXIT
1672	ELSE IF (iesc > 1) THEN
1673	! ESC is not first char: copy until ESC
1674	str = str//tmp(j:j+iesc-2)
1675	ENDIF
1676	! search for m
1677	im = INDEX(tmp(j+iesc:),"m")
1678	! no m in the string after ESC --> copy string (INCLUDING ESC) and leave
1679	IF (im == 0) THEN
1680	str = str//tmp(j+iesc-1:)
1681	RETURN
1682	ENDIF
1683	csi = tmp(j+iesc-1:j+iesc+im-1)
1684	! we have a csi: we add new codes to it
1685	IF (is_csi(csi)) THEN
1686	csi = str_del_from_csi(csi,attrs)
1687	ENDIF
1688	csis=csis//csi//"\|"
1689	str = str//csi
1690	j = j + iesc + im
1691	ENDDO
1692	! Add <ESC>[0m at the end of string if not found
1693	IF (INDEX(str,rcsi,.true.) /= LEN(str)-3) str = str//rcsi
1694	! resets all attributes if we only have <ESC>[0m in final list
1695	ok = tokenize(csis(1:LEN(csis)-1),tks,"\|")
1696	IF (ALL(tks == rcsi)) str = reset_csi(str)
1697	DEALLOCATE(tks)
1698	RETURN
1699	END FUNCTION del_csi
1700
1701	FUNCTION reset_csi(string) RESULT(str)
1702	!! Reset all csi codes of the string
1703	!!
1704	!! The method removes __all__ the known escape sequences from the input string.
1705	CHARACTER(len=*), INTENT(in) :: string
1706	!! Input string
1707	CHARACTER(len=:), ALLOCATABLE :: str
1708	!! An allocatable string with the copy of input string stripped off csi codes.
1709	INTEGER :: j,iesc,im
1710	LOGICAL :: tcsi
1711	str = ""
1712	IF (LEN(string) == 0) RETURN
1713	j=1
1714	DO
1715	IF (j>LEN(string)) EXIT
1716	! search for escape
1717	iesc = INDEX(string(j:),CHAR(27))
1718	IF (iesc == 0) THEN
1719	str = str//string(j:) ; EXIT
1720	ENDIF
1721	! search for m
1722	im = INDEX(string(j+iesc:),"m")
1723	! no m in the string after ESC --> copy string (INCLUDING ESC) and leave
1724	IF (im == 0) THEN
1725	str = str//string(j+iesc-1:)
1726	RETURN
1727	ENDIF
1728	! csi includes everything between ESC and m (excluding them):
1729	! to check for csi it should begin by [ and then be a list of integers
1730	! separated by ;
1731	tcsi = is_csi(string(j+iesc-1:j+iesc+im-1))
1732	IF (iesc > 1) THEN
1733	str = str//string(j:j+iesc-2)
1734	ENDIF
1735	j = j + iesc ; IF (tcsi) j=j+im
1736	ENDDO
1737	RETURN
1738	END FUNCTION reset_csi
1739
1740	FUNCTION is_csi(value) RESULT(yes)
1741	!! Check if string is a known csi
1742	!!
1743	!! The function only check for known csi code which are defined in [[string_op(module):attributes(variable)]].
1744	CHARACTER(len=*), INTENT(in) :: value
1745	!! A Fortran intrinsic string to check
1746	LOGICAL :: yes
1747	!! .true. if it is a known csi, .false. otherwise
1748	LOGICAL :: ok
1749	CHARACTER(len=:), ALLOCATABLE :: tmp
1750	TYPE(words) :: wtks
1751	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: stks
1752	INTEGER, DIMENSION(:), ALLOCATABLE :: nums
1753	INTEGER :: i
1754	yes = .false.
1755	IF (LEN(value) < 4) RETURN
1756	tmp = value(3:len(value)-1)
1757	call words_extend(wtks,tmp,';')
1758	ok = words_to_vector(wtks,stks)
1759	CALL ws_clear_sc(wtks)
1760	IF (.NOT.ok) RETURN
1761	! if we cannot convert strings to integers : it is not a csi
1762	IF (.NOT.from_string(stks,nums)) RETURN
1763	DEALLOCATE(stks)
1764	DO i=1, SIZE(nums)
1765	IF (.NOT.ANY(attributes == nums(i))) RETURN
1766	ENDDO
1767	yes = .true.
1768	END FUNCTION is_csi
1769
1770	FUNCTION str_add_to_csi(csi,list) RESULT(ncsi)
1771	!! Add a new list of codes to the input csi string
1772	!!
1773	!! The method adds all the csi codes given in __list__ that are known by the module and not
1774	!! already present in the input csi.
1775	CHARACTER(len=*), INTENT(in) :: csi
1776	!! A string with the input csi. It __must__ begin with "<ESC>[" and ends with "m".
1777	INTEGER, INTENT(in), DIMENSION(:) :: list
1778	!! A vector of integers with the csi code to add. Each value of __list__ should be one of
1779	!! [[string_op(module):attributes(variable)]] values. All unknown values are filtered out as well
1780	!! as csi code already present in input __csi__.
1781	CHARACTER(len=:), ALLOCATABLE :: ncsi
1782	!! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
1783	!! be tokenized or none of __list__ values are left after filtering).
1784	LOGICAL :: ok
1785	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tks
1786	CHARACTER(len=:), ALLOCATABLE :: tmp
1787	INTEGER, DIMENSION(:), ALLOCATABLE :: zlist,nums
1788	INTEGER :: i,j,ni,no
1789	! 1) Filter input list :
1790	! 1.1) Gets the list of current csi codes
1791	ncsi = csi(3:len(csi)-1)
1792	ok = tokenize(ncsi,tks,"; ",merge=.true.)
1793	IF (.NOT.from_string(tks,nums)) THEN
1794	ncsi = csi
1795	RETURN
1796	ENDIF
1797	DEALLOCATE(tks)
1798	! 1.2) Filter input list of new flags to add
1799	! counts number of valid flags
1800	j=0
1801	DO i=1,SIZE(list)
1802	! new flags must be in attributes but NOT in nums
1803	IF (ANY(attributes==list(i).AND..NOT.ANY(nums == list(i)))) j=j+1
1804	ENDDO
1805	! No "valid" flags -> returns old csi
1806	IF (j == 0) THEN ; ncsi = csi ; RETURN ; ENDIF
1807	ni = SIZE(nums) ; no = j + ni
1808	ALLOCATE(zlist(no)) ; zlist(1:ni) = nums(:) ; j = ni
1809	DO i=1,SIZE(list)
1810	! new flags must be in attributes but NOT in nums
1811	IF (ANY(attributes==list(i).AND..NOT.ANY(nums == list(i)))) THEN
1812	j=j+1 ; zlist(j) = list(i)
1813	ENDIF
1814	ENDDO
1815	DEALLOCATE(nums)
1816	! 2) Builds new csi
1817	! Here we explictly set the first flag to 0 (i.e. reset attributes)...
1818	ncsi = CHAR(27)//"[0;"
1819	DO i=1,no
1820	! ... So we get rid of all "0" flag in the list
1821	IF (zlist(i) /= 0) THEN
1822	tmp = to_string(zlist(i))
1823	IF (LEN_TRIM(tmp) == 0) THEN
1824	ncsi = csi ; RETURN
1825	ENDIF
1826	ncsi = ncsi//tmp
1827	IF (i /= no) ncsi = ncsi//";"
1828	ENDIF
1829	ENDDO
1830	ncsi = ncsi//"m"
1831	END FUNCTION str_add_to_csi
1832
1833	FUNCTION str_del_from_csi(csi,list) RESULT(ncsi)
1834	!! Remove a list of codes from the input csi string
1835	!!
1836	!! The method removes all the csi codes given in __list__ that are known by the
1837	!! module and already present in the input csi.
1838	CHARACTER(len=*), INTENT(in) :: csi
1839	!! An intrinsic Fortran string with the input csi. It __must__ begin with "<ESC>[" and ends with "m".
1840	INTEGER, INTENT(in), DIMENSION(:) :: list
1841	!! A vector of integers with the csi code to remove. Each value of __list__ should be one of
1842	!! [[string_op(module):attributes(variable)]] values. All unknown values are filtered out.
1843	CHARACTER(len=:), ALLOCATABLE :: ncsi
1844	!! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
1845	!! be tokenized or none of __list__ values are left after filtering).
1846	LOGICAL :: ok
1847	CHARACTER(len=LEN(csi)), DIMENSION(:), ALLOCATABLE :: tks
1848	CHARACTER(len=:), ALLOCATABLE :: tmp
1849	INTEGER, DIMENSION(:), ALLOCATABLE :: nums
1850	INTEGER :: i
1851	ncsi = csi(3:len(csi)-1)
1852	ok = tokenize(ncsi,tks,"; ",merge=.true.)
1853	IF (.NOT.from_string(tks,nums)) THEN
1854	ncsi = csi
1855	RETURN
1856	ENDIF
1857	DEALLOCATE(tks)
1858	tmp=""
1859	DO i=1, SIZE(nums)
1860	IF (ALL(nums(i) /= list).AND.nums(i) /= 0) THEN
1861	! no need to check for to_string status : it is always ok !
1862	tmp=tmp//to_string(nums(i))//";"
1863	ENDIF
1864	ENDDO
1865	IF (LEN_TRIM(tmp) /= 0) THEN
1866	ncsi=CHAR(27)//"[0;"//tmp(1:LEN(tmp)-1)//"m"
1867	ELSE
1868	ncsi=CHAR(27)//"[0m"
1869	ENDIF
1870	END FUNCTION str_del_from_csi
1871
1872	FUNCTION str_index_of_csi(str,length) RESULT(pos)
1873	!! Get the position of the first known csi in string
1874	!!
1875	!! The method searches for the first known csi in string. The csi must contain known codes
1876	!! (i.e. values of [[string_op(module):attributes(variable)]]).
1877	CHARACTER(len=*), INTENT(in) :: str !! A string to search in
1878	INTEGER, INTENT(out) :: length !! Length of the csi in the string
1879	INTEGER :: pos !! Position of the first csi found. It is set to 0 if no csi has been found.
1880	INTEGER :: iesc,im
1881	pos = 0 ; length = 0
1882	! we need at least 4 chars to create a csi
1883	IF (LEN_TRIM(str) < 4) RETURN
1884	iesc = INDEX(str,CHAR(27))
1885	IF (iesc == 0) RETURN
1886	! search for m
1887	im = INDEX(str(iesc:),"m")
1888	! no m in the string after ESC --> copy string (INCLUDING ESC) and leave
1889	IF (im == 0) RETURN
1890	IF (.NOT.is_csi(str(iesc:iesc+im-1))) RETURN
1891	pos = iesc ; length = im
1892	END FUNCTION str_index_of_csi
1893
1894	! String conversion functions
1895	! ---------------------------
1896
1897	FUNCTION str2int_sc(str, value) RESULT(ret)
1898	!! Convert string value to integer value (scalar)
1899	CHARACTER(len=*), INTENT(in) :: str !! String to convert
1900	INTEGER, INTENT(out) :: value !! Output value
1901	LOGICAL :: ret !! Return status (.true. on success)
1902	CHARACTER(len=:), ALLOCATABLE :: zs
1903	ret = .true. ; zs = remove_quotes(str)
1904	IF (string_is(zs) /= st_integer) THEN
1905	ret = .false.
1906	ELSE
1907	READ(zs, *) value
1908	ENDIF
1909	RETURN
1910	END FUNCTION str2int_sc
1911
1912	FUNCTION str2log_sc(str, value) RESULT(ret)
1913	!! Convert string value to logical value (scalar)
1914	CHARACTER(len=*), INTENT(in) :: str !! String to convert
1915	LOGICAL, INTENT(out) :: value !! Output value
1916	LOGICAL :: ret !! Return status (.true. on success)
1917	CHARACTER(len=:), ALLOCATABLE :: zs
1918	integer :: r
1919	ret = .true. ; zs = remove_quotes(str)
1920	r = string_is(zs)
1921	IF (string_is(zs) /= st_logical) THEN
1922	ret = .false.
1923	ELSE
1924	READ(zs, *) value
1925	ENDIF
1926	RETURN
1927	END FUNCTION str2log_sc
1928
1929	FUNCTION str2real_sc(str, value) RESULT(ret)
1930	!! Convert string value to simple precision floating precision value (scalar)
1931	CHARACTER(len=*), INTENT(in) :: str !! String to convert
1932	REAL(kind=4), INTENT(out) :: value !! Output value
1933	LOGICAL :: ret !! Return status (.true. on success)
1934	CHARACTER(len=:), ALLOCATABLE :: zs
1935	ret = .true.; zs = remove_quotes(str)
1936	IF (string_is(zs) < st_integer) THEN
1937	ret = .false.
1938	ELSE
1939	READ(zs, *) value
1940	ENDIF
1941	RETURN
1942	END FUNCTION str2real_sc
1943
1944	FUNCTION str2dble_sc(str, value) RESULT(ret)
1945	!! Convert string value to double precision floating precision value (scalar)
1946	CHARACTER(len=*), INTENT(in) :: str !! String to convert
1947	REAL(kind=8), INTENT(out) :: value !! Output value
1948	LOGICAL :: ret !! Return status (.true. on success)
1949	CHARACTER(len=:), ALLOCATABLE :: zs
1950	ret = .true. ; zs = remove_quotes(str)
1951	IF (string_is(zs) < st_integer) THEN
1952	ret = .false.
1953	ELSE
1954	READ(zs, *) value
1955	ENDIF
1956	RETURN
1957	END FUNCTION str2dble_sc
1958
1959	FUNCTION str2cplx_sc(str, value) RESULT(ret)
1960	!! Convert string value to complex value (scalar)
1961	CHARACTER(len=*), INTENT(in) :: str !! String to convert
1962	COMPLEX(kind=4), INTENT(out) :: value !! Output value
1963	LOGICAL :: ret !! Return status (.true. on success)
1964	! - LOCAL
1965	CHARACTER(len=:), ALLOCATABLE :: zs
1966	ret = .true. ; zs = remove_quotes(str)
1967	IF (string_is(zs) /= st_complex) THEN
1968	ret = .false.
1969	ELSE
1970	READ(zs, *) value
1971	ENDIF
1972	RETURN
1973	END FUNCTION str2cplx_sc
1974
1975	FUNCTION str2int_ve(str, value) RESULT(ret)
1976	!! Convert strings values to integer values (vector)
1977	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: str !! Vector of strings to convert
1978	INTEGER, INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
1979	LOGICAL :: ret !! Return status (.true. on success)
1980	INTEGER :: i,ns
1981	CHARACTER(len=:), ALLOCATABLE :: zs
1982	ret = .true. ; ns = SIZE(str) ; ALLOCATE(value(ns))
1983	DO i=1,ns
1984	zs = remove_quotes(str(i))
1985	IF (string_is(zs) /= st_integer) THEN
1986	ret = .false. ; DEALLOCATE(value) ; RETURN
1987	ELSE
1988	READ(zs, *) value(i)
1989	ENDIF
1990	ENDDO
1991	RETURN
1992	END FUNCTION str2int_ve
1993
1994	FUNCTION str2log_ve(str, value) RESULT(ret)
1995	!! Convert strings values to logical values (vector)
1996	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: str !! Vector of strings to convert
1997	LOGICAL, INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
1998	LOGICAL :: ret !! Return status (.true. on success)
1999	INTEGER :: i,ns
2000	CHARACTER(len=:), ALLOCATABLE :: zs
2001	ret = .true. ; ns = SIZE(str) ; ALLOCATE(value(ns))
2002	DO i=1,ns
2003	zs = remove_quotes(str(i))
2004	IF (string_is(zs) /= st_logical) THEN
2005	ret = .false. ; DEALLOCATE(value) ; RETURN
2006	ELSE
2007	READ(zs, *) value(i)
2008	ENDIF
2009	ENDDO
2010	RETURN
2011	END FUNCTION str2log_ve
2012
2013	FUNCTION str2real_ve(str, value) RESULT(ret)
2014	!! Convert strings values to simple precision floating point values (vector)
2015	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: str !! Vector of strings to convert
2016	REAL(kind=4), INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
2017	LOGICAL :: ret !! Return status (.true. on success)
2018	INTEGER :: i,ns
2019	CHARACTER(len=:), ALLOCATABLE :: zs
2020	ret = .true. ; ns = SIZE(str) ; ALLOCATE(value(ns))
2021	DO i=1,ns
2022	IF (string_is(zs) < st_integer) THEN
2023	ret = .false. ; DEALLOCATE(value) ; RETURN
2024	ELSE
2025	READ(zs, *) value(i)
2026	ENDIF
2027	ENDDO
2028	RETURN
2029	END FUNCTION str2real_ve
2030
2031	FUNCTION str2dble_ve(str, value) RESULT(ret)
2032	!! Convert strings values to double precision floating point values (vector)
2033	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: str !! Vector of strings to convert
2034	REAL(kind=8), INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
2035	LOGICAL :: ret !! Return status (.true. on success)
2036	INTEGER :: i,ns
2037	CHARACTER(len=:), ALLOCATABLE :: zs
2038	ret = .true. ; ns = SIZE(str) ; ALLOCATE(value(ns))
2039	DO i=1,ns
2040	zs = remove_quotes(str(i))
2041	IF (string_is(zs) < st_integer) THEN
2042	ret = .false. ; DEALLOCATE(value) ; RETURN
2043	ELSE
2044	READ(zs, *) value(i)
2045	ENDIF
2046	ENDDO
2047	RETURN
2048	END FUNCTION str2dble_ve
2049
2050	FUNCTION str2cplx_ve(str, value) RESULT(ret)
2051	!! Convert strings values to complex values (vector)
2052	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: str !! Vector of strings to convert
2053	COMPLEX(kind=4), INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
2054	LOGICAL :: ret !! Return status (.true. on success)
2055	INTEGER :: i,ns
2056	CHARACTER(len=:), ALLOCATABLE :: zs
2057	ret = .true. ; ns = SIZE(str) ; ALLOCATE(value(ns))
2058	DO i=1,ns
2059	zs = remove_quotes(str(i))
2060	IF (string_is(zs) /= st_complex) THEN
2061	ret = .false. ; DEALLOCATE(value) ; RETURN
2062	ELSE
2063	READ(zs, *) value(i)
2064	ENDIF
2065	ENDDO
2066	RETURN
2067	END FUNCTION str2cplx_ve
2068
2069	FUNCTION int2str_as(value) RESULT(str)
2070	!! Convert an integer value to string (auto format / string result)
2071	INTEGER, INTENT(in) :: value !! Value to convert
2072	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2073	INTEGER :: err
2074	ALLOCATE(CHARACTER(len=DIGITS(value)) :: str)
2075	WRITE(str,*,iostat=err) value
2076	str = TRIM(ADJUSTL(str))
2077	IF (err /= 0) str = ''
2078	RETURN
2079	END FUNCTION int2str_as
2080
2081	FUNCTION log2str_as(value) RESULT(str)
2082	!! Convert a logical value to string (auto format / string result)
2083	LOGICAL, INTENT(in) :: value !! Value to convert
2084	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2085	INTEGER :: err
2086	ALLOCATE(CHARACTER(len=2) :: str)
2087	WRITE(str, *, IOSTAT = err) value
2088	str=TRIM(ADJUSTL(str))
2089	IF (err /= 0) str = ''
2090	RETURN
2091	END FUNCTION log2str_as
2092
2093	FUNCTION real2str_as(value) RESULT(str)
2094	!! Convert a simple precision floating point value to string (auto format / string result)
2095	REAL(kind=4), INTENT(in) :: value !! Value to convert
2096	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2097	INTEGER :: err
2098	ALLOCATE(CHARACTER(len=DIGITS(value)) ::str)
2099	WRITE(str,*, IOSTAT = err) value
2100	str=TRIM(ADJUSTL(str))
2101	IF (err /= 0) str = ''
2102	RETURN
2103	END FUNCTION real2str_as
2104
2105	FUNCTION dble2str_as(value) RESULT(str)
2106	!! Convert a double precision floating point value to string (auto format / string result)
2107	REAL(kind=8), INTENT(in) :: value !! Value to convert
2108	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2109	INTEGER :: err
2110	ALLOCATE(CHARACTER(len=DIGITS(value)) ::str)
2111	WRITE(str,*, IOSTAT = err) value
2112	str=TRIM(ADJUSTL(str))
2113	IF (err /= 0) str = ''
2114	RETURN
2115	END FUNCTION dble2str_as
2116
2117	FUNCTION cplx2str_as(value) RESULT(str)
2118	!! Convert a complex value to string (auto format / string result)
2119	COMPLEX(kind=4), INTENT(in) :: value !! Value to convert
2120	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2121	INTEGER :: err,sl
2122	sl = DIGITS(REAL(value))*2+3
2123	ALLOCATE(CHARACTER(len=sl) :: str)
2124	WRITE(str, *, IOSTAT = err) value
2125	str = TRIM(ADJUSTL(str))
2126	IF (err /= 0) str = ''
2127	RETURN
2128	END FUNCTION cplx2str_as
2129
2130	FUNCTION dcplx2str_as(value) RESULT(str)
2131	!! Convert a complex value to string (auto format / string result)
2132	COMPLEX(kind=8), INTENT(in) :: value !! Value to convert
2133	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2134	INTEGER :: err,sl
2135	sl = DIGITS(REAL(value))*2+3
2136	ALLOCATE(CHARACTER(len=sl) :: str)
2137	WRITE(str, *, IOSTAT = err) value
2138	str = TRIM(ADJUSTL(str))
2139	IF (err /= 0) str = ''
2140	RETURN
2141	END FUNCTION dcplx2str_as
2142
2143	FUNCTION int2str_fs(value, fmt) RESULT(str)
2144	!! Convert an integer value to string (user format / string result)
2145	INTEGER, INTENT(in) :: value !! Value to convert
2146	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2147	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2148	INTEGER :: err
2149	ALLOCATE(CHARACTER(len=st_slen) :: str)
2150	WRITE(str, '('//fmt//')', IOSTAT = err) value
2151	str = TRIM(ADJUSTL(str))
2152	IF (err /= 0) str = ''
2153	RETURN
2154	END FUNCTION int2str_fs
2155
2156	FUNCTION log2str_fs(value, fmt) RESULT(str)
2157	!! Convert a logical value to string (user format / string result)
2158	LOGICAL, INTENT(in) :: value !! Value to convert
2159	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2160	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2161	INTEGER :: err
2162	ALLOCATE(CHARACTER(len=st_slen) :: str)
2163	WRITE(str, '('//fmt//')', IOSTAT = err) value
2164	str=TRIM(ADJUSTL(str))
2165	IF (err /= 0) str = ''
2166	RETURN
2167	END FUNCTION log2str_fs
2168
2169	FUNCTION real2str_fs(value, fmt) RESULT(str)
2170	!! Convert a simple precision floating point value to string (user format / string result)
2171	REAL(kind=4), INTENT(in) :: value !! Value to convert
2172	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2173	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2174	INTEGER :: err
2175	ALLOCATE(CHARACTER(len=st_slen) :: str)
2176	WRITE(str, '('//fmt//')', IOSTAT = err) value
2177	str = TRIM(ADJUSTL(str))
2178	IF (err /= 0) str = ''
2179	RETURN
2180	END FUNCTION real2str_fs
2181
2182	FUNCTION dble2str_fs(value, fmt) RESULT(str)
2183	!! Convert a double precision floating point value to string (user format / string result)
2184	REAL(kind=8), INTENT(in) :: value !! Value to convert
2185	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2186	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2187	INTEGER :: err
2188	ALLOCATE(CHARACTER(len=st_slen) :: str)
2189	WRITE(str, '('//fmt//')', IOSTAT = err) value
2190	str = TRIM(ADJUSTL(str))
2191	IF (err /= 0) str = ''
2192	RETURN
2193	END FUNCTION dble2str_fs
2194
2195	FUNCTION cplx2str_fs(value, fmt) RESULT(str)
2196	!! Convert a complex value to string (user format / string result)
2197	COMPLEX(kind=4), INTENT(in) :: value !! Value to convert
2198	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2199	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2200	INTEGER :: err
2201	ALLOCATE(CHARACTER(len=st_slen) :: str)
2202	WRITE(str, '('//fmt//')', IOSTAT = err) value
2203	str = TRIM(ADJUSTL(str))
2204	IF (err /= 0) str = ''
2205	RETURN
2206	END FUNCTION cplx2str_fs
2207
2208	FUNCTION dcplx2str_fs(value, fmt) RESULT(str)
2209	!! Convert a complex value to string (user format / string result)
2210	COMPLEX(kind=8), INTENT(in) :: value !! Value to convert
2211	CHARACTER(len=*), INTENT(in) :: fmt !! String format
2212	CHARACTER(len=:), ALLOCATABLE :: str !! String with the converted value in output
2213	INTEGER :: err
2214	ALLOCATE(CHARACTER(len=st_slen) :: str)
2215	WRITE(str, '('//fmt//')', IOSTAT = err) value
2216	str = TRIM(ADJUSTL(str))
2217	IF (err /= 0) str = ''
2218	RETURN
2219	END FUNCTION dcplx2str_fs
2220
2221	! Extended strings features
2222	! ---------------------------
2223
2224	FUNCTION fis_cat_int(str1,int2) RESULT(str)
2225	!! Concatenate a fortran intrinsic string with a integer.
2226	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2227	INTEGER, INTENT(in) :: int2 !! Integer to concatenate
2228	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2229	ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
2230	WRITE(str,*) int2 ; str = TRIM(ADJUSTL(str))
2231	IF (LEN(str1) /= 0) str = str1//str
2232	RETURN
2233	END FUNCTION fis_cat_int
2234
2235	!! @param[in] int2 An integer to concatenate
2236	!! @param[in] str1 A string to concatenate
2237	!! @return An allocatable string with the concatenation of input values.
2238	FUNCTION fis_cat_int_inv(int2,str1) RESULT(str)
2239	!! Concatenate a fortran intrinsic string with a integer (reversed).
2240	INTEGER, INTENT(in) :: int2 !! Integer to concatenate
2241	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2242	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2243	ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
2244	WRITE(str,*) int2 ; str = TRIM(ADJUSTL(str))
2245	IF (LEN(str1) /= 0) str = str//str1
2246	RETURN
2247	END FUNCTION fis_cat_int_inv
2248
2249	FUNCTION fis_cat_bool(str1,bool2) RESULT(str)
2250	!! Concatenate a string with a logical
2251	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2252	LOGICAL, INTENT(in) :: bool2 !! Logical to concatenate
2253	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2254	CHARACTER(len=2) ::tmp
2255	WRITE(tmp,*) bool2
2256	str=TRIM(ADJUSTL(tmp))
2257	IF (LEN(str1) /= 0) str = str1//str
2258	RETURN
2259	END FUNCTION fis_cat_bool
2260
2261	FUNCTION fis_cat_bool_inv(bool2,str1) RESULT(str)
2262	!! Concatenate a string with a logical (reversed)
2263	LOGICAL, INTENT(in) :: bool2 !! Logical to concatenate
2264	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2265	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2266	CHARACTER(len=2) ::tmp
2267	WRITE(tmp,*) bool2
2268	str = TRIM(ADJUSTL(tmp))
2269	IF (LEN(str1) /= 0) str = str//str1
2270	RETURN
2271	END FUNCTION fis_cat_bool_inv
2272
2273	FUNCTION fis_cat_real(str1,real2) RESULT(str)
2274	!! Concatenate a string with a real simple precision
2275	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2276	REAL(kind=4), INTENT(in) :: real2 !! Simple precision real to concatenate
2277	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2278	ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
2279	WRITE(str,*) real2 ; str = TRIM(ADJUSTL(str))
2280	IF (LEN(str1) /= 0) str=str1//str
2281	RETURN
2282	END FUNCTION fis_cat_real
2283
2284	FUNCTION fis_cat_real_inv(real2,str1) RESULT(str)
2285	!! Concatenate a string with a real simple precision (reversed)
2286	REAL(kind=4), INTENT(in) :: real2 !! Simple precision real to concatenate
2287	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2288	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2289	ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
2290	WRITE(str,*) real2 ; str = TRIM(ADJUSTL(str))
2291	IF (LEN(str1) /= 0) str = str//str1
2292	RETURN
2293	END FUNCTION fis_cat_real_inv
2294
2295	FUNCTION fis_cat_double(str1,double2) RESULT(str)
2296	!! Concatenate a string with a real double precision
2297	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2298	REAL(kind=8), INTENT(in) :: double2 !! Double precision real to concatenate
2299	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2300	ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
2301	WRITE(str,*) double2 ; str = TRIM(ADJUSTL(str))
2302	IF (LEN(str1) /= 0) str=str1//str
2303	RETURN
2304	END FUNCTION fis_cat_double
2305
2306	FUNCTION fis_cat_double_inv(double2,str1) RESULT(str)
2307	!! Concatenate a string with a real double precision (reversed)
2308	REAL(kind=8), INTENT(in) :: double2 !! Double precision real to concatenate
2309	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2310	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2311	ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
2312	WRITE(str,*) double2 ; str = TRIM(ADJUSTL(str))
2313	IF (LEN(str1) /= 0) str = str//str1
2314	RETURN
2315	END FUNCTION fis_cat_double_inv
2316
2317	FUNCTION fis_cat_cplx(str1,cplx2) RESULT(str)
2318	!! Concatenate a string with a complex
2319	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2320	COMPLEX(kind=4), INTENT(in) :: cplx2 !! Complex value to concatenate
2321	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2322	INTEGER :: sl
2323	sl = DIGITS(REAL(cplx2))*2+3
2324	ALLOCATE(CHARACTER(len=sl) :: str)
2325	WRITE(str,*) cplx2 ; str = TRIM(ADJUSTL(str))
2326	IF (LEN(str1) /= 0) str = str//str1
2327	RETURN
2328	END FUNCTION fis_cat_cplx
2329
2330	FUNCTION fis_cat_cplx_inv(cplx2,str1) RESULT(str)
2331	!! Concatenate a string with a complex (reversed)
2332	COMPLEX(kind=4), INTENT(in) :: cplx2 !! Complex value to concatenate
2333	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2334	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2335	INTEGER :: sl
2336	sl = DIGITS(REAL(cplx2))*2+3
2337	ALLOCATE(CHARACTER(len=sl) :: str)
2338	WRITE(str,*) cplx2
2339	str = TRIM(ADJUSTL(str))
2340	IF (LEN(str1) /= 0) str = str//str1
2341	RETURN
2342	END FUNCTION fis_cat_cplx_inv
2343
2344	FUNCTION fis_cat_dcplx(str1,dcplx2) RESULT(str)
2345	!! Concatenate a string with a double precision complex
2346	CHARACTER(len=*), INTENT(in) :: str1 !! String to concatenate
2347	COMPLEX(kind=8), INTENT(in) :: dcplx2 !! Complex value to concatenate
2348	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2349	INTEGER :: sl
2350	sl = DIGITS(REAL(dcplx2))*2+3
2351	ALLOCATE(CHARACTER(len=sl) :: str)
2352	WRITE(str,*) dcplx2 ; str = TRIM(ADJUSTL(str))
2353	IF (LEN(str1) /= 0) str = str//str1
2354	RETURN
2355	END FUNCTION fis_cat_dcplx
2356
2357	FUNCTION fis_cat_dcplx_inv(dcplx2,str1) RESULT(str)
2358	!! Concatenate a string with a double precision complex (reversed)
2359	COMPLEX(kind=8), INTENT(in) :: dcplx2 !! Complex value to concatenate
2360	CHARACTER(len=*), INTENT(in) :: str1 !! string to concatenate
2361	CHARACTER(len=:), ALLOCATABLE :: str !! Output string
2362	INTEGER :: sl
2363	sl = DIGITS(REAL(dcplx2))*2+3
2364	ALLOCATE(CHARACTER(len=sl) :: str)
2365	WRITE(str,*) dcplx2
2366	str = TRIM(ADJUSTL(str))
2367	IF (LEN(str1) /= 0) str = str//str1
2368	RETURN
2369	END FUNCTION fis_cat_dcplx_inv
2370
2371	SUBROUTINE fis_affect_int(str,int)
2372	!! Assignment subroutine (using intrinsic integer)
2373	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2374	INTEGER, INTENT(in) :: int !! Input value to assign
2375	str = fis_cat_int('',int)
2376	END SUBROUTINE fis_affect_int
2377
2378	SUBROUTINE fis_affect_bool(str,bool)
2379	!! Assignment subroutine (using intrinsic logical)
2380	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2381	LOGICAL, INTENT(in) :: bool !! Input value to assign
2382	str = fis_cat_bool('',bool)
2383	END SUBROUTINE fis_affect_bool
2384
2385	SUBROUTINE fis_affect_real(str,float)
2386	!! Assignment subroutine (using intrinsic real)
2387	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2388	REAL(kind=4), INTENT(in) :: float !! Input value to assign
2389	str = fis_cat_real('',float)
2390	END SUBROUTINE fis_affect_real
2391
2392	SUBROUTINE fis_affect_double(str,double)
2393	!! Assignment subroutine (using intrinsic real(kind=8))
2394	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2395	REAL(kind=8), INTENT(in) :: double !! Input value to assign
2396	str = fis_cat_double('',double)
2397	END SUBROUTINE fis_affect_double
2398
2399	SUBROUTINE fis_affect_cplx(str,cplx)
2400	!! Assignment subroutine (using intrinsic complex)
2401	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2402	COMPLEX(kind=4), INTENT(in) :: cplx !! Input value to assign
2403	str = fis_cat_cplx('',cplx)
2404	END SUBROUTINE fis_affect_cplx
2405
2406	SUBROUTINE fis_affect_dcplx(str,dcplx)
2407	!! Assignment subroutine (using intrinsic complex(kind=8))
2408	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
2409	COMPLEX(kind=8), INTENT(in) :: dcplx !! Input value to assign
2410	str = fis_cat_dcplx('',dcplx)
2411	END SUBROUTINE fis_affect_dcplx
2412
2413	FUNCTION get_attrs_indexes(flags) RESULT(codes)
2414	!! Convert a list of csi flags into a csi codes.
2415	!!
2416	!! Only know CSI codes are returned. If no known CSI are found the outputput vector is
2417	!! allocated with 0 elements.
2418	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2419	INTEGER, DIMENSION(:), ALLOCATABLE :: codes !! CSI codes.
2420	INTEGER :: i,j,n
2421	n = 0
2422	ALLOCATE(codes(SIZE(flags)))
2423	codes(:) = -1
2424	DO i = 1, SIZE(flags)
2425	DO j = 1, SIZE(attributes)
2426	IF (to_lower(flags(i)) == csis(j)) THEN
2427	n = n + 1
2428	codes(n) = attributes(j)
2429	EXIT
2430	ENDIF
2431	ENDDO
2432	ENDDO
2433	IF (n > 0) THEN
2434	codes = codes(1:n)
2435	ELSE
2436	DEALLOCATE(codes)
2437	ALLOCATE(codes(0))
2438	ENDIF
2439	END FUNCTION get_attrs_indexes
2440
2441	FUNCTION fancy_fstr(value,flags,fmt) RESULT(output)
2442	!! Compute a fancy string from the given (fortran intrinsic) string.
2443	CHARACTER(len=*), INTENT(in) :: value !! String object reference
2444	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2445	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format (unused for this overload)
2446	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2447	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2448	codes = get_attrs_indexes(flags)
2449	IF (SIZE(codes) == 0) THEN
2450	output = value ; RETURN
2451	ELSE
2452	output = add_csi(value,codes)
2453	ENDIF
2454	END FUNCTION fancy_fstr
2455
2456	FUNCTION fancy_int(value,flags,fmt) RESULT(output)
2457	!! Compute a fancy string from the given integer value.
2458	INTEGER, INTENT(in) :: value !! String object reference
2459	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2460	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2461	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2462	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2463	CHARACTER(len=:), ALLOCATABLE :: tmp
2464	codes = get_attrs_indexes(flags)
2465	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2466	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2467	END FUNCTION fancy_int
2468
2469	FUNCTION fancy_bool(value,flags,fmt) RESULT(output)
2470	!! Compute a fancy string from the given logical value.
2471	LOGICAL, INTENT(in) :: value !! String object reference
2472	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2473	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2474	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2475	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2476	CHARACTER(len=:), ALLOCATABLE :: tmp
2477	codes = get_attrs_indexes(flags)
2478	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2479	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2480	END FUNCTION fancy_bool
2481
2482	FUNCTION fancy_real(value,flags,fmt) RESULT(output)
2483	!! Compute a fancy string from the given real value (simple precision).
2484	REAL(kind=4), INTENT(in) :: value !! String object reference
2485	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2486	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2487	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2488	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2489	CHARACTER(len=:), ALLOCATABLE :: tmp
2490	codes = get_attrs_indexes(flags)
2491	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2492	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2493	END FUNCTION fancy_real
2494
2495	FUNCTION fancy_double(value,flags,fmt) RESULT(output)
2496	!! Compute a fancy string from the given real value (double precision).
2497	REAL(kind=8), INTENT(in) :: value !! String object reference
2498	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2499	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2500	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2501	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2502	CHARACTER(len=:), ALLOCATABLE :: tmp
2503	codes = get_attrs_indexes(flags)
2504	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2505	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2506	END FUNCTION fancy_double
2507
2508	FUNCTION fancy_cplx(value,flags,fmt) RESULT(output)
2509	!! Compute a fancy string from the given complex value (simple precision).
2510	COMPLEX(kind=4), INTENT(in) :: value !! String object reference
2511	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2512	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2513	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2514	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2515	CHARACTER(len=:), ALLOCATABLE :: tmp
2516	codes = get_attrs_indexes(flags)
2517	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2518	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2519	END FUNCTION fancy_cplx
2520
2521	FUNCTION fancy_dcplx(value,flags,fmt) RESULT(output)
2522	!! Compute a fancy string from the given complex value (double precision).
2523	COMPLEX(kind=8), INTENT(in) :: value !! String object reference
2524	CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
2525	CHARACTER(len=*), INTENT(in), OPTIONAL :: fmt !! Optional format. If given it must be a valid Fortran format.
2526	CHARACTER(len=:), ALLOCATABLE :: output !! Output fortran instrinsic string
2527	INTEGER, DIMENSION(:), ALLOCATABLE :: codes
2528	CHARACTER(len=:), ALLOCATABLE :: tmp
2529	codes = get_attrs_indexes(flags)
2530	IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
2531	IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
2532	END FUNCTION fancy_dcplx
2533
2534	END MODULE SWIFT_STRING_OP

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

Download in other formats:

Original Format