Context Navigation

string_op.F90 @ 3094

Last change on this file since 3094 was 3090, checked in by slebonnois, 15 months ago
BdeBatz? : Cleans microphysics and makes few corrections for physics
File size: 101.2 KB

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

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

Download in other formats:

Original Format