Context Navigation

string_op.F90 @ 3026

Last change on this file since 3026 was 1897, checked in by jvatant, 7 years ago

Making Titan's hazy again - part II
+ Major updates of J.Burgalat YAMMS library and optical coupling, including :
++ Added the routines for haze optics inside YAMMS
++ Calling rad. transf. with interactive haze is plugged
in but should stay unactive as long as the microphysics is
in test phase : cf "uncoupl_optic_haze" flag : true for now !
++ Also some sanity checks for negative tendencies and
some others upkeep of YAMMS model
+ Also added a temporary CPP key USE_QTEST in physiq_mod
that enables to have microphysical tendencies separated
from dynamics for debugging and test phases
-- JVO and JB

File size: 102.0 KB

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

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

Download in other formats:

Original Format