Context Navigation

readTracFiles_mod.f90 @ 5189

Last change on this file since 5189 was 5184, checked in by dcugnet, 3 months ago
Few corrections, more is needed to fix the previous commit.
File size: 172.7 KB

Line
1	MODULE readTracFiles_mod
2
3	USE strings_mod, ONLY: msg, find, get_in, dispTable, strHead, strReduce, strFind, strStack, strIdx, &
4	removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
5	int2str, str2int, real2str, str2real, bool2str, str2bool
6
7	IMPLICIT NONE
8
9	PRIVATE
10
11	PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH
12	PUBLIC :: keys_type, tracers, setGeneration, indexUpdate !--- TRACERS DESCRIPTION DATABASE + ASSOCIATED TOOLS
13	PUBLIC :: testTracersFiles, readTracersFiles !--- TRACERS FILES READING ROUTINES
14	PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
15	PUBLIC :: addTracer, delTracer !--- ADD/REMOVE A TRACER FROM
16	PUBLIC :: addKey, delKey, getKey !--- TOOLS TO SET/DEL/GET KEYS FROM/TO tracers & isotopes
17	PUBLIC :: addPhase, delPhase, getPhase, getiPhase, & !--- FUNCTIONS RELATED TO THE PHASES
18	nphases, old_phases, phases_sep, known_phases, phases_names !--- + ASSOCIATED VARIABLES
19
20	PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
21	PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc)
22
23	PUBLIC :: tran0 !--- TRANSPORTING FLUID (USUALLY air)
24
25	!=== FOR ISOTOPES: GENERAL
26	PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
27
28	!=== FOR ISOTOPES: H2O FAMILY ONLY
29	PUBLIC :: iH2O
30
31	!=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
32	PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
33	PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
34	PUBLIC :: niso, nzone, nphas, ntiso !--- " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
35	PUBLIC :: itZonIso !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
36	PUBLIC :: iqIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx)
37	PUBLIC :: iqWIsoPha !--- SAME AS iqIsoPha BUT ISOTOPES LIST STARTS WITH PARENT TRAC
38	PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
39
40	PUBLIC :: maxTableWidth
41	!------------------------------------------------------------------------------------------------------------------------------
42	TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
43	CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:) !--- Keys string list
44	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:) !--- Corresponding values string list
45	END TYPE keys_type
46	!------------------------------------------------------------------------------------------------------------------------------
47	TYPE :: isot_type !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "name"
48	CHARACTER(LEN=maxlen) :: name !--- Isotopes family name (example: H2O)
49	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
50	LOGICAL :: check=.FALSE. !--- Flag for checking routines triggering
51	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
52	CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
53	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas)
54	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
55	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
56	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
57	INTEGER :: nphas = 0 !--- Number of phases
58	INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
59	!--- (former name: "iqiso"
60	INTEGER, ALLOCATABLE :: iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
61	INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
62	END TYPE isot_type !--- (former name: "index_trac")
63	!------------------------------------------------------------------------------------------------------------------------------
64	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
65	CHARACTER(LEN=maxlen) :: name !--- Section name
66	TYPE(keys_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
67	END TYPE dataBase_type
68	!------------------------------------------------------------------------------------------------------------------------------
69	INTERFACE getKey
70	MODULE PROCEDURE &
71	getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
72	getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
73	getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
74	getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
75	getKeyByName_s111, getKeyByName_sm11, getKeyByName_s1m1, getKeyByName_smm1, getKeyByName_s1mm, getKeyByName_smmm, &
76	getKeyByName_i111, getKeyByName_im11, getKeyByName_i1m1, getKeyByName_imm1, getKeyByName_i1mm, getKeyByName_immm, &
77	getKeyByName_r111, getKeyByName_rm11, getKeyByName_r1m1, getKeyByName_rmm1, getKeyByName_r1mm, getKeyByName_rmmm, &
78	getKeyByName_l111, getKeyByName_lm11, getKeyByName_l1m1, getKeyByName_lmm1, getKeyByName_l1mm, getKeyByName_lmmm
79	END INTERFACE getKey
80	!------------------------------------------------------------------------------------------------------------------------------
81	INTERFACE addKey
82	MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
83	addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
84	END INTERFACE addKey
85	!------------------------------------------------------------------------------------------------------------------------------
86	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
87	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
88	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
89	INTERFACE addTracer; MODULE PROCEDURE addTracer_1, addTracer_1def; END INTERFACE addTracer
90	INTERFACE delTracer; MODULE PROCEDURE delTracer_1, delTracer_1def; END INTERFACE delTracer
91	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
92	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
93	!------------------------------------------------------------------------------------------------------------------------------
94
95	!=== MAIN DATABASE: files sections descriptors
96	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
97
98	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
99	CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
100	CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlirb' !--- Old phases for water (no separator)
101	CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb' !--- Known phases initials
102	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
103	CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
104	= ['gaseous ', 'liquid ', 'solid ', 'cloud ','blownSnow']
105	CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator
106	CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
107
108	!--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
109	CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ]
110	CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO ', 'H218O', 'H217O', 'HTO ']
111
112	!--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
113	CHARACTER(LEN=maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 ']
114	CHARACTER(LEN=maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot']
115
116	!=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
117	TYPE(keys_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
118	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
119
120	!=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
121	TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
122	INTEGER, SAVE :: ixIso, iH2O=0 !--- Index of the selected isotopes family and H2O family
123	INTEGER, SAVE :: nbIso !--- Number of isotopes classes
124	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
125	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
126	CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
127	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
128	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
129	INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
130	nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
131	INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx)
132	iqIsoPha(:,:), & !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
133	iqWIsoPha(:,:) !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
134
135	!=== PARAMETERS FOR DEFAULT BEHAVIOUR
136	LOGICAL, PARAMETER :: lTracsMerge = .FALSE. !--- Merge/stack tracers lists
137	LOGICAL, PARAMETER :: lSortByGen = .TRUE. !--- Sort by growing generation
138
139	INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"
140	CHARACTER(LEN=maxlen) :: modname
141
142	CONTAINS
143
144	!==============================================================================================================================
145	!==============================================================================================================================
146	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
147	!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
148	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
149	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
150	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
151	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
152	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
153	!=== REMARKS:
154	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
155	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
156	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
157	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
158	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
159	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
160	!=== ABOUT THE KEYS:
161	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
162	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
163	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
164	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
165	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
166	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
167	!==============================================================================================================================
168	LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
169	!------------------------------------------------------------------------------------------------------------------------------
170	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
171	TYPE(keys_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:) !--- Tracers descriptor for external storage
172	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNO3 exceptions for REPROBUS
173	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
174	CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname, ttype
175	INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
176	INTEGER, ALLOCATABLE :: iGen(:)
177	LOGICAL :: lRep
178	TYPE(keys_type), POINTER :: k
179	!------------------------------------------------------------------------------------------------------------------------------
180	lerr = .FALSE.
181	modname = 'readTracersFiles'
182	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
183	lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
184
185	!--- Required sections + corresponding files names (new style single section case) for tests
186	lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
187	nsec = SIZE(sections)
188
189	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
190	SELECT CASE(fType) !--- Set name, component, parent, phase, iGeneration, gen0Name, type
191	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
192	CASE(1) !=== OLD FORMAT "traceur.def"
193	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
194	!--- OPEN THE "traceur.def" FILE
195	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', POSITION='REWIND', IOSTAT=ierr)
196
197	!--- GET THE TRACERS NUMBER
198	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
199	lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
200
201	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
202	ALLOCATE(tracers(ntrac))
203	DO it = 1, ntrac !=== READ RAW DATA: loop on the line/tracer number
204	READ(90,'(a)',IOSTAT=ierr) str
205	lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
206	lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
207	lerr = strParse(str, ' ', s, ns)
208	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
209	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
210	k => tracers(it)
211
212	!=== NAME OF THE TRACER
213	tname = old2newH2O(s(3), ip)
214	ix = strIdx(oldHNO3, s(3))
215	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
216	CALL addKey('name', tname, tracers) !--- Set the name of the tracer
217	! tracers(it)%name = tname !--- Copy tracers names in keys components
218
219	!=== NAME OF THE COMPONENT
220	cname = type_trac !--- Name of the model component
221	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
222	CALL addKey('component', cname, tracers) !--- Set the name of the model component
223
224	!=== NAME OF THE PARENT
225	pname = tran0 !--- Default name: default transporting fluid (air)
226	IF(ns == 4) THEN
227	pname = old2newH2O(s(4))
228	ix = strIdx(oldHNO3, s(4))
229	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
230	END IF
231	CALL addKey('parent', pname, tracers) !--- Set the parent name
232
233	!=== PHASE AND ADVECTION SCHEMES NUMBERS
234	CALL addKey('phase', known_phases(ip:ip), tracers) !--- Set the phase of the tracer (default: "g"azeous)
235	CALL addKey('hadv', s(1), k) !--- Set the horizontal advection schemes number
236	CALL addKey('vadv', s(2), k) !--- Set the vertical advection schemes number
237	END DO
238	CLOSE(90)
239	lerr = setGeneration(tracers); IF(lerr) RETURN !--- Set iGeneration and gen0Name
240	lerr = getKey('iGeneration', iGen, tracers(:)) !--- Generation number
241	DO it = 1, ntrac
242	ttype = 'tracer'; IF(iGen(it) == 2) ttype = 'tag'
243	CALL addKey('type', ttype, tracers(it)) !--- Set the type of tracer
244	END DO
245	lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN !--- Detect orphans and check phases
246	lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN !--- Detect repeated tracers
247	CALL sortTracers (tracers) !--- Sort the tracers
248	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
249	CASE(2); lerr=feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
250	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
251	CASE(3); lerr=feedDBase( trac_files , sections, modname); IF(lerr) RETURN !=== MULTIPLE FILES, SINGLE SECTION
252	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
253	END SELECT
254	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
255	IF(ALL([2,3] /= fType)) RETURN
256	IF(nsec == 1) tracers = dBase(1)%trac
257	IF(nsec /= 1) THEN
258	CALL msg('Multiple sections are MERGED', modname, lTracsMerge)
259	CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
260	IF( lTracsMerge) lerr = cumulTracers(dBase, tracers)
261	IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
262	IF(lerr) RETURN
263	END IF
264	lerr = indexUpdate(tracers); IF(lerr) RETURN !--- Set iqParent, iqDescen, nqDescen, nqChildren
265	IF(PRESENT(tracs)) tracs = tracers
266	END FUNCTION readTracersFiles
267	!==============================================================================================================================
268
269
270	!==============================================================================================================================
271	LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
272	CHARACTER(LEN=*), INTENT(IN) :: modname, type_trac
273	INTEGER, INTENT(OUT) :: fType
274	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
275	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
276	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
277	LOGICAL, ALLOCATABLE :: ll(:)
278	LOGICAL :: lD, lFound
279	INTEGER :: is, nsec
280	lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
281	lerr = .FALSE.
282
283	!--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
284	!--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
285	lerr = strParse(type_trac, '\|', sections, n=nsec); IF(lerr) RETURN !--- Parse "type_trac" list
286	IF(PRESENT(sects)) sects = sections
287	ALLOCATE(trac_files(nsec), ll(nsec))
288	DO is=1, nsec
289	trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'
290	INQUIRE(FILE=TRIM(trac_files(is)), EXIST=ll(is))
291	END DO
292	IF(PRESENT(tracf)) tracf = trac_files
293	fType = 0
294	INQUIRE(FILE='traceur.def', EXIST=lFound); IF(lFound) fType = 1 !--- OLD STYLE FILE
295	INQUIRE(FILE='tracer.def', EXIST=lFound); IF(lFound) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
296	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
297	IF(.NOT.lD) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
298	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
299	lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
300	END IF
301
302	!--- TELLS WHAT WAS IS ABOUT TO BE USED
303	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
304	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
305	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
306	END FUNCTION testTracersFiles
307	!==============================================================================================================================
308
309	!==============================================================================================================================
310	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
311	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
312	! file and create the corresponding tracers set descriptors in the database "dBase":
313	! * dBase(id)%name : section name
314	! * dBase(id)%trac(:) : tracers descriptor (the key "name" of tracers(i) is the name of the ith tracer)
315	! * dBase(id)%trac(it)%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
316	! * dBase(id)%trac(it)%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
317	!------------------------------------------------------------------------------------------------------------------------------
318	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
319	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
320	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling routine name
321	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
322	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
323	CHARACTER(LEN=maxlen) :: fnm, snm
324	INTEGER :: idb, i
325	LOGICAL :: ll
326	!------------------------------------------------------------------------------------------------------------------------------
327	!=== READ THE REQUIRED SECTIONS
328	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
329	ALLOCATE(ixf(SUM(ndb)))
330	DO i=1, SIZE(fnames) !--- Set name, keys
331	lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
332	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
333	END DO
334	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
335	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
336	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
337	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
338	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
339	lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ; SET parent, type, component
340	lerr = setGeneration(dBase(idb)%trac); IF(lerr) RETURN !--- SET iGeneration, genOName
341	lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
342	lerr = checkUnique (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
343	lerr = expandPhases (dBase(idb)%trac); IF(lerr) RETURN !--- EXPAND PHASES ; set phase
344	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
345	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
346	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
347	END DO
348	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
349	END FUNCTION feedDBase
350	!------------------------------------------------------------------------------------------------------------------------------
351
352	!------------------------------------------------------------------------------------------------------------------------------
353	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
354	!------------------------------------------------------------------------------------------------------------------------------
355	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
356	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Pipe-separated sections list
357	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
358	!------------------------------------------------------------------------------------------------------------------------------
359	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
360	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
361	INTEGER, ALLOCATABLE :: ix(:)
362	INTEGER :: n0, idb, ndb
363	LOGICAL :: ll
364	!------------------------------------------------------------------------------------------------------------------------------
365	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
366	CALL readSections_all() !--- Read all the sections of file "fnam"
367	ndb= SIZE(dBase) !--- Current number of sections in the database
368	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
369	DO idb=n0,ndb !--- and remove the virtual tracer "defName"
370	lerr = addDefault(dBase(idb)%trac, defName); IF(lerr) RETURN
371	END DO
372	END IF
373	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
374	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
375	lerr = checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'); IF(lerr) RETURN
376	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
377
378	CONTAINS
379
380	!------------------------------------------------------------------------------------------------------------------------------
381	SUBROUTINE readSections_all()
382	!------------------------------------------------------------------------------------------------------------------------------
383	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
384	TYPE(keys_type), ALLOCATABLE :: tt(:)
385	CHARACTER(LEN=1024) :: str, str2
386	CHARACTER(LEN=maxlen) :: secn
387	INTEGER :: ierr, n
388	!------------------------------------------------------------------------------------------------------------------------------
389	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
390	OPEN(90, FILE=fnam, FORM='formatted', POSITION='REWIND', STATUS='old')
391	DO; str=''
392	DO
393	READ(90,'(a)', IOSTAT=ierr)str2 !--- Read a full line
394	str=TRIM(str)//' '//TRIM(str2) !--- Append "str" with the current line
395	n=LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
396	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
397	str = str(1:n-1) !--- Remove the "\" continuing line symbol
398	END DO
399	str = ADJUSTL(str) !--- Remove the front space
400	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
401	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
402	CALL removeComment(str) !--- Skip comments at the end of a line
403	IF(LEN_TRIM(str) == 0) CYCLE !--- Empty line (probably end of file)
404	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
405	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
406	ndb = SIZE(dBase) !--- Number of sections so far
407	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
408	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
409	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
410	ndb = ndb + 1 !--- Extend database
411	ALLOCATE(tdb(ndb))
412	tdb(1:ndb-1) = dBase
413	tdb(ndb)%name = secn
414	ALLOCATE(tdb(ndb)%trac(0))
415	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
416	ELSE !=== TRACER LINE
417	ll = strParse(str,' ', s, n, v) !--- Parse <key>=<val> pairs
418	tt = dBase(ndb)%trac(:)
419	v(1) = s(1); s(1) = 'name' !--- Convert "name" into a regular key
420	dBase(ndb)%trac = [tt(:), keys_type(s(:), v(:))]
421	DEALLOCATE(tt)
422	END IF
423	END DO
424	CLOSE(90)
425
426	END SUBROUTINE readSections_all
427	!------------------------------------------------------------------------------------------------------------------------------
428
429	END FUNCTION readSections
430	!==============================================================================================================================
431
432
433	!==============================================================================================================================
434	LOGICAL FUNCTION addDefault(t, defName) RESULT(lerr)
435	!------------------------------------------------------------------------------------------------------------------------------
436	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
437	!------------------------------------------------------------------------------------------------------------------------------
438	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
439	CHARACTER(LEN=*), INTENT(IN) :: defName
440	INTEGER :: jd, it, k
441	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
442	TYPE(keys_type), ALLOCATABLE :: tt(:)
443	lerr = getKey('name', tname, t(:)); IF(lerr) RETURN
444	jd = strIdx(tname(:), defName)
445	IF(jd == 0) RETURN
446	DO k = 1, SIZE(t(jd)%key) !--- Loop on the keys of the tracer named "defName"
447	! CALL addKey(t(jd)%key(k), t(jd)%val(k), t(:), .FALSE.) !--- Add key to all the tracers (no overwriting)
448	DO it = 1, SIZE(t); CALL addKey(t(jd)%key(k), t(jd)%val(k), t(it), .FALSE.); END DO
449	END DO
450	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
451	END FUNCTION addDefault
452	!==============================================================================================================================
453
454	!==============================================================================================================================
455	LOGICAL FUNCTION subDefault(t, defName, lSubLocal) RESULT(lerr)
456	!------------------------------------------------------------------------------------------------------------------------------
457	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
458	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
459	!------------------------------------------------------------------------------------------------------------------------------
460	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
461	CHARACTER(LEN=*), INTENT(IN) :: defName
462	LOGICAL, INTENT(IN) :: lSubLocal
463	INTEGER :: i0, it, ik
464	TYPE(keys_type), ALLOCATABLE :: tt(:)
465	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
466	lerr = getKey('name', tname, t(:)); IF(lerr) RETURN
467	i0 = strIdx(tname(:), defName)
468	IF(i0 == 0) RETURN
469	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
470
471	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
472	DO ik = 1, SIZE(t(i0)%key); CALL strReplace(t(it)%val, t(i0)%key(ik), t(i0)%val(ik), .TRUE.); END DO
473
474	IF(.NOT.lSubLocal) CYCLE
475	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
476	DO ik = 1, SIZE(t(it)%key); CALL strReplace(t(it)%val, t(it)%key(ik), t(it)%val(ik), .TRUE.); END DO
477	END DO
478	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
479
480	END FUNCTION subDefault
481	!==============================================================================================================================
482
483
484	!==============================================================================================================================
485	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
486	!------------------------------------------------------------------------------------------------------------------------------
487	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
488	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
489	! * Default values are provided for these keys because they are necessary.
490	!------------------------------------------------------------------------------------------------------------------------------
491	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
492	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Current section name
493	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- Tracers description file name
494	TYPE(keys_type), ALLOCATABLE :: ttr(:)
495	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
496	CHARACTER(LEN=maxlen) :: msg1, modname
497	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
498	LOGICAL :: ll
499	modname = 'expandSection'
500	lerr = .FALSE.
501	nt = SIZE(tr)
502	lerr = getKey('name', tname, tr(:)); IF(lerr) RETURN
503	lerr = getKey('parent', parent, tr(:), def = tran0); IF(lerr) RETURN
504	lerr = getKey('type', dType, tr(:), def = 'tracer'); IF(lerr) RETURN
505	nq = 0
506	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
507	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
508	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
509	!--- Extract useful keys: parent name, type, component name
510	CALL addKey('component', sname, tr(it))
511
512	!--- Determine the number of tracers and parents ; coherence checking
513	ll = strCount( tname(it), ',', ntr)
514	ll = strCount(parent(it), ',', npr)
515
516	!--- Tagging tracers only can have multiple parents
517	lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
518	IF(lerr) THEN
519	msg1 = 'Check section "'//TRIM(sname)//'"'
520	IF(PRESENT(fname)) msg1 = TRIM(msg1)//' in file "'//TRIM(fname)//'"'
521	CALL msg(TRIM(msg1)//': "'//TRIM(tname(it))//'" has several parents but is not a tag', modname); RETURN
522	END IF
523	nq = nq + ntr*npr
524	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
525	END DO
526	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
527
528	ALLOCATE(ttr(nq))
529	iq = 1
530	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
531	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
532	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
533	ll = strParse( tname(it), ',', ta, ntr) !--- Number of tracers
534	ll = strParse(parent(it), ',', pa, npr) !--- Number of parents
535	DO ipr = 1, npr !--- Loop on parents list elts
536	DO itr = 1, ntr !--- Loop on tracers list elts
537	ttr(iq)%key = tr(it)%key
538	ttr(iq)%val = tr(it)%val
539	CALL addKey('name', ta(itr), ttr(iq))
540	CALL addKey('parent', pa(ipr), ttr(iq))
541	CALL addKey('type', dType(it), ttr(iq))
542	CALL addKey('component', sname, ttr(iq))
543	iq = iq + 1
544	END DO
545	END DO
546	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
547	END DO
548	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
549	DEALLOCATE(ta,pa)
550	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
551
552	END FUNCTION expandSection
553	!==============================================================================================================================
554
555
556	!==============================================================================================================================
557	LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
558	!------------------------------------------------------------------------------------------------------------------------------
559	! Purpose: Determine, for each tracer of "tr(:)":
560	! * iGeneration: the generation number
561	! * gen0Name: the generation 0 ancestor name
562	! Check also for orphan tracers (tracers without parent).
563	!------------------------------------------------------------------------------------------------------------------------------
564	TYPE(keys_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
565	INTEGER :: iq, jq, ig
566	CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), tname(:)
567	!------------------------------------------------------------------------------------------------------------------------------
568	CHARACTER(LEN=maxlen) :: modname
569	modname = 'setGeneration'
570	lerr = getKey('name', tname, ky=tr(:)); IF(lerr) RETURN
571	lerr = getKey('parent', parent, ky=tr(:)); IF(lerr) RETURN
572	DO iq = 1, SIZE(tr)
573	jq = iq; ig = 0
574	DO WHILE(parent(jq) /= tran0)
575	jq = strIdx(tname(:), parent(jq))
576	lerr = jq == 0
577	IF(fmsg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr)) RETURN
578	ig = ig + 1
579	END DO
580	CALL addKey('iGeneration', ig, tr(iq))
581	CALL addKey('gen0Name', tname(jq), tr(iq))
582	END DO
583	END FUNCTION setGeneration
584	!==============================================================================================================================
585
586
587	!==============================================================================================================================
588	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
589	!------------------------------------------------------------------------------------------------------------------------------
590	! Purpose:
591	! * check for orphan tracers (without parent)
592	! * check wether the phases are known or not (elements of "known_phases")
593	!------------------------------------------------------------------------------------------------------------------------------
594	TYPE(keys_type), INTENT(IN) :: tr(:) !--- Tracers description vector
595	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
596	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
597	CHARACTER(LEN=1) :: p
598	CHARACTER(LEN=maxlen) :: mesg
599	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
600	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
601	INTEGER, ALLOCATABLE :: iGen(:)
602	INTEGER :: ip, np, iq, nq
603	!------------------------------------------------------------------------------------------------------------------------------
604	CHARACTER(LEN=maxlen) :: modname
605	modname = 'checkTracers'
606	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
607	mesg = 'Check section "'//TRIM(sname)//'"'
608	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
609	lerr = getKey('iGeneration', iGen, tr(:)); IF(lerr) RETURN
610	lerr = getKey('name', tname, tr(:)); IF(lerr) RETURN
611
612	!=== CHECK FOR ORPHAN TRACERS
613	lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
614
615	!=== CHECK PHASES
616	DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE !--- Generation O only is checked
617	IF(getKey(['phases','phase '], pha, iq, tr(:), lDisp=.FALSE.)) pha = 'g' !--- Phase
618	np = LEN_TRIM(pha); bp(iq)=' '
619	DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq))//p; END DO
620	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq))//': '//TRIM(bp(iq))
621	END DO
622	lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
623	END FUNCTION checkTracers
624	!==============================================================================================================================
625
626
627	!==============================================================================================================================
628	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
629	!------------------------------------------------------------------------------------------------------------------------------
630	! Purpose: Make sure that tracers are not repeated.
631	!------------------------------------------------------------------------------------------------------------------------------
632	TYPE(keys_type), INTENT(IN) :: tr(:) !--- Tracers description vector
633	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
634	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
635	!------------------------------------------------------------------------------------------------------------------------------
636	INTEGER :: ip, np, iq, nq, k
637	LOGICAL, ALLOCATABLE :: ll(:)
638	CHARACTER(LEN=maxlen) :: mesg, phase, tdup(SIZE(tr,DIM=1))
639	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), dType(:)
640	INTEGER, ALLOCATABLE :: iGen(:)
641	CHARACTER(LEN=1) :: p
642	!------------------------------------------------------------------------------------------------------------------------------
643	CHARACTER(LEN=maxlen) :: modname
644	modname = 'checkUnique'
645	mesg = 'Check section "'//TRIM(sname)//'"'
646	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
647	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
648	tdup(:) = ''
649	lerr = getKey('name', tname, tr); IF(lerr) RETURN
650	lerr = getKey('type', dType, tr); IF(lerr) RETURN
651	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN
652	DO iq = 1, nq
653	IF(dType(iq) == 'tag') CYCLE !--- Tags can be repeated
654	ll = tname==TRIM(tname(iq)) !--- Mask for current tracer name
655	IF(COUNT(ll) == 1) CYCLE !--- Tracer is not repeated
656	IF(iGen(iq) > 0) THEN
657	tdup(iq) = tname(iq) !--- gen>0: MUST be unique
658	ELSE
659	DO ip = 1, nphases; p = known_phases(ip:ip) !--- Loop on known phases
660	np = 0
661	DO k = 1, nq
662	IF(.NOT.ll(k)) CYCLE !--- Skip tracers different from current one
663	IF(getKey(['phases','phase '], phase, k, tr, lDisp=.FALSE.)) phase='g'!--- Get current phases
664	IF(INDEX(phase, p) /= 0) np = np + 1 !--- One more appearance of current tracer with phase "p"
665	END DO
666	IF(np <= 1) CYCLE !--- Regular case: no or a single appearance
667	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip)) !--- Repeated phase
668	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
669	END DO
670	END IF
671	IF(tdup(iq) /= '') tdup(iq)=TRIM(tname(iq))//' in '//TRIM(tdup(iq))//' phase(s)'
672	END DO
673	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
674	END FUNCTION checkUnique
675	!==============================================================================================================================
676
677
678	!==============================================================================================================================
679	LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
680	!------------------------------------------------------------------------------------------------------------------------------
681	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
682	!------------------------------------------------------------------------------------------------------------------------------
683	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracers description vector
684	!------------------------------------------------------------------------------------------------------------------------------
685	TYPE(keys_type), ALLOCATABLE :: ttr(:)
686	INTEGER, ALLOCATABLE :: i0(:), iGen(:)
687	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
688	CHARACTER(LEN=maxlen) :: nam, gen0Nm, pha, parent
689	CHARACTER(LEN=1) :: p
690	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
691	LOGICAL :: lTag, lExt
692	!------------------------------------------------------------------------------------------------------------------------------
693	CHARACTER(LEN=maxlen) :: modname
694	modname = 'expandPhases'
695	nq = SIZE(tr, DIM=1)
696	nt = 0
697	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names of the tracers
698	lerr = getKey('gen0Name', gen0N, tr); IF(lerr) RETURN !--- Names of the tracers of first generation
699	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN !--- Generation number
700	lerr = getKey('phases', phase, tr); IF(lerr) RETURN !--- Phases names
701	lerr = getKey('parent', parents, tr); IF(lerr) RETURN !--- Parents names
702	lerr = getKey('type', dType, tr); IF(lerr) RETURN !--- Tracers types ('tracer' or 'tag')
703	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
704	IF(iGen(iq) /= 0) CYCLE !--- Only deal with generation 0 tracers
705	nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0) !--- Number of children of tr(iq)
706	np = LEN_TRIM(phase(iq)) !--- Number of phases of tr(iq)
707	nt = nt + (1+nc) * np !--- Number of tracers after expansion
708	END DO
709	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
710	it = 1 !--- Current "ttr(:)" index
711	DO iq = 1, nq !--- Loop on "tr(:)" indexes
712	lTag = dType(iq)=='tag' !--- Current tracer is a tag
713	i0 = strFind(tname, TRIM(gen0N(iq)), n) !--- Indexes of first generation ancestor copies
714	np = SUM([( LEN_TRIM(phase(i0(i))), i = 1, n )], 1) !--- Number of phases for current tracer tr(iq)
715	lExt = np > 1 !--- Phase suffix only required if phases number is > 1
716	IF(lTag) lExt = lExt .AND. iGen(iq) > 0 !--- No phase suffix for generation 0 tags
717	DO i = 1, n !=== LOOP ON GENERATION 0 ANCESTORS
718	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
719	IF(iGen(iq) == 0) jq = iq !--- Generation 0: count the current tracer phases only
720	pha = phase(jq) !--- Phases list for tr(jq)
721	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
722	p = pha(ip:ip)
723	nam = tname(iq) !--- Tracer name (regular case)
724	IF(lTag) nam = TRIM(parents(iq)) !--- Parent name (tagging case)
725	IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed
726	IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname(iq)) !--- <parent>_<name> for tags
727	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
728	CALL addKey('name', nam, ttr(it)) !--- Name with possibly phase suffix
729	CALL addKey('phase', p, ttr(it)) !--- Single phase entry
730	IF(lExt) THEN
731	parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
732	gen0Nm = gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
733	CALL addKey('parent', parent, ttr(it))
734	CALL addKey('gen0Name', gen0Nm, ttr(it))
735	END IF
736	it = it+1
737	END DO
738	IF(iGen(iq) == 0) EXIT !--- Break phase loop for gen 0
739	END DO
740	END DO
741	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
742	CALL delKey(['phases'], tr) !--- Remove "phases" key, useless since "phase" is defined
743
744	END FUNCTION expandPhases
745	!==============================================================================================================================
746
747
748	!==============================================================================================================================
749	SUBROUTINE sortTracers(tr)
750	!------------------------------------------------------------------------------------------------------------------------------
751	! Purpose: Sort tracers:
752	! * Put water at the beginning of the vector, in the "known_phases" order.
753	! * lGrowGen == T: in ascending generations numbers.
754	! * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
755	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
756	!------------------------------------------------------------------------------------------------------------------------------
757	TYPE(keys_type), INTENT(INOUT) :: tr(:) !--- Tracers description vector
758	!------------------------------------------------------------------------------------------------------------------------------
759	TYPE(keys_type), ALLOCATABLE :: tr2(:)
760	INTEGER, ALLOCATABLE :: iy(:), iz(:), iGen(:)
761	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:)
762	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
763	LOGICAL :: lerr
764	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
765	!------------------------------------------------------------------------------------------------------------------------------
766	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN !--- Generation number
767	nq = SIZE(tr)
768	DO ip = nphases, 1, -1
769	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names of the tracers of first generation
770	iq = strIdx(tname, addPhase('H2O', ip))
771	IF(iq == 0) CYCLE
772	tr2 = tr(:)
773	tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
774	END DO
775	IF(lSortByGen) THEN
776	iq = 1
777	ng = MAXVAL(iGen, MASK=.TRUE., DIM=1) !--- Number of generations
778	DO ig = 0, ng !--- Loop on generations
779	iy = PACK([(k, k=1, nq)], MASK=iGen(:) == ig) !--- Generation ig tracers indexes
780	n = SIZE(iy)
781	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
782	iq = iq + n
783	END DO
784	ELSE
785	lerr = getKey('gen0Name', gen0N, tr); IF(lerr) RETURN !--- Names of the tracers iq = 1
786	DO jq = 1, nq !--- Loop on generation 0 tracers
787	IF(iGen(jq) /= 0) CYCLE !--- Skip generations /= 0
788	ix(iq) = jq !--- Generation 0 ancestor index first
789	iq = iq + 1 !--- Next "iq" for next generations tracers
790	iy = strFind(gen0N(:), TRIM(tname(jq))) !--- Indices of "tr(jq)" children in "tr(:)"
791	ng = MAXVAL(iGen(iy), MASK=.TRUE., DIM=1) !--- Number of generations of the "tr(jq)" family
792	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
793	iz = find(iGen(iy), ig, n) !--- Indices of the tracers "tr(iy(:))" of generation "ig"
794	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
795	iq = iq + n
796	END DO
797	END DO
798	END IF
799	tr = tr(ix) !--- Reorder the tracers
800	END SUBROUTINE sortTracers
801	!==============================================================================================================================
802
803
804	!==============================================================================================================================
805	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
806	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
807	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
808	TYPE(keys_type), POINTER :: t1(:), t2(:)
809	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
810	INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
811	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
812	CHARACTER(LEN=maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
813	modname = 'mergeTracers'
814	lerr = .FALSE.
815	keys = ['parent ', 'type ', 'iGeneration'] !--- Mandatory keys
816	t1 => sections(1)%trac(:) !--- Alias: first tracers section
817	lerr = getKey('name', n1, t1); IF(lerr) RETURN !--- Names of the tracers
818	tr = t1
819	!----------------------------------------------------------------------------------------------------------------------------
820	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
821	!----------------------------------------------------------------------------------------------------------------------------
822	t2 => sections(is)%trac(:) !--- Alias: current tracers section
823	lerr = getKey('name', n2, t2); IF(lerr) RETURN !--- Names of the tracers
824	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
825	ixct = strIdx(n1(:), n2(:)) !--- Indexes of common tracers
826	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
827	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
828	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
829	CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax=128) !--- Display duplicates (the 128 first at most)
830	!--------------------------------------------------------------------------------------------------------------------------
831	DO i2=1,nt2; tnam = TRIM(n2(i2)) !=== LOOP ON COMMON TRACERS
832	!--------------------------------------------------------------------------------------------------------------------------
833	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
834
835	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
836	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
837	DO ik = 1, SIZE(keys)
838	lerr = getKey(keys(ik), v1, i1, t1)
839	lerr = getKey(keys(ik), v2, i2, t2)
840	lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
841	END DO
842
843	!=== GET THE INDICES IN tr(i2)%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%key(:)
844	nk2 = SIZE(t2(i2)%key(:)) !--- Keys number in current section
845	ixck = strIdx(t1(i1)%key(:), t2(i2)%key(:)) !--- Common keys indexes
846	!--- APPEND THE NEW KEYS PAIRS IN tr(i1)%key(:)
847	tr(i1)%key = [ tr(i1)%key, PACK(tr(i2)%key, MASK = ixck==0)]
848	tr(i1)%val = [ tr(i1)%val, PACK(tr(i2)%val, MASK = ixck==0)]
849
850	!=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
851	lerr = getKey('component', v1, i1, t1)
852	lerr = getKey('component', v2, i2, t2)
853	CALL addKey('component', TRIM(v1)//','//TRIM(v2), tr(i1))
854
855	!=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
856	DO ik2 = 1, nk2 !--- Collect the corresponding indices
857	ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
858	IF(t1(i1)%val(ik1) == t2(i2)%val(ik2)) ixck(ik2)=0
859	END DO
860	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values => nothing to display
861	CALL msg('Key(s)'//TRIM(s1), modname) !--- Display the keys with /=values (names list)
862	DO ik2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
863	knam = t2(i2)%key(ik2) !--- Name of the current key
864	ik1 = ixck(ik2) !--- Corresponding index in t1(:)
865	IF(ik1 == 0) CYCLE !--- New keys are skipped
866	v1 = t1(i1)%val(ik1); v2 = t2(i2)%val(ik2) !--- Key values in t1(:) and t2(:)
867	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
868	END DO
869	!------------------------------------------------------------------------------------------------------------------------
870	END DO
871	!--------------------------------------------------------------------------------------------------------------------------
872	END DO
873	CALL sortTracers(tr)
874
875	END FUNCTION mergeTracers
876	!==============================================================================================================================
877
878	!==============================================================================================================================
879	LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
880	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
881	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
882	LOGICAL, OPTIONAL, INTENT(IN) :: lRename !--- .TRUE.: add a section suffix to identical names
883	CHARACTER(LEN=maxlen) :: tnam_new, modname
884	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
885	INTEGER :: iq, jq, is
886	modname = 'cumulTracers'
887	lerr = .FALSE.
888	tr = [( sections(is)%trac(:), is = 1, SIZE(sections) )] !--- Concatenated tracers vector
889	IF(PRESENT(lRename)) THEN; IF(lRename) RETURN; END IF !--- No renaming: finished
890	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names
891	lerr = getKey('parent', parent, tr); IF(lerr) RETURN !--- Parents
892	lerr = getKey('component', comp, tr); IF(lerr) RETURN !--- Component name
893	!----------------------------------------------------------------------------------------------------------------------------
894	DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE !=== LOOP ON TRACERS
895	!----------------------------------------------------------------------------------------------------------------------------
896	tnam_new = TRIM(tname(iq))//'_'//TRIM(comp(iq)) !--- Same with section extension
897	CALL addKey('name', tnam_new, tr(iq)) !--- Modify tracer name
898	!--------------------------------------------------------------------------------------------------------------------------
899	DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE !=== LOOP ON TRACERS PARENTS
900	!--------------------------------------------------------------------------------------------------------------------------
901	CALL addKey('parent', tnam_new, tr(jq)) !--- Modify tracer name
902	!--------------------------------------------------------------------------------------------------------------------------
903	END DO
904	!----------------------------------------------------------------------------------------------------------------------------
905	END DO
906	!----------------------------------------------------------------------------------------------------------------------------
907	CALL sortTracers(tr)
908	END FUNCTION cumulTracers
909	!==============================================================================================================================
910
911
912	!==============================================================================================================================
913	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
914	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
915	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:,:), n(:), tmp(:)
916	CHARACTER(LEN=maxlen) :: p
917	INTEGER :: idb, iq, nq
918	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
919	nq = SIZE(dBase(idb)%trac)
920	p = ''
921	CALL append(['iq'], .TRUE. ); IF(lerr) RETURN
922	CALL append(['name'], .TRUE. ); IF(lerr) RETURN
923	CALL append(['phases','phase '], .FALSE., 'pha'); IF(lerr) RETURN
924	CALL append(['hadv'], .TRUE. ); IF(lerr) RETURN
925	CALL append(['vadv'], .TRUE. ); IF(lerr) RETURN
926	CALL append(['parent'], .FALSE.); IF(lerr) RETURN
927	CALL append(['iGen'], .FALSE.); IF(lerr) RETURN
928	CALL msg(TRIM(message)//':', modname)
929	lerr = dispTable(p, n, s, nColMax=maxTableWidth, nHead=2, sub=modname); IF(lerr) RETURN
930
931	CONTAINS
932
933	SUBROUTINE append(nam, lMandatory, snam)
934	! Test whether key named "nam(:)" is available.
935	! * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
936	! - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
937	! * no: return to calling routine with an error flag if the required key is mandatory
938	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
939	LOGICAL, INTENT(IN) :: lMandatory
940	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: snam
941	INTEGER :: m
942	CHARACTER(LEN=maxlen), ALLOCATABLE :: n0(:)
943	CHARACTER(LEN=maxlen) :: nm
944	lerr = .FALSE.
945	IF(nam(1) == 'iq') THEN
946	tmp = int2str([(iq, iq=1, nq)])
947	ELSE
948	lerr = getKey(nam, tmp, dBase(idb)%trac(:), lDisp=lMandatory)
949	END IF
950	IF(lerr) THEN; lerr = lMandatory; RETURN; END IF
951	nm = nam(1); IF(PRESENT(snam)) nm = snam
952	p = TRIM(p)//'s'
953	IF(ALLOCATED(s)) THEN; s = cat(s, tmp); ELSE; ALLOCATE(s(nq,1)); s(:,1) = tmp; END IF
954	IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m+1)); n0(1:m)=n; n0(m+1)=nm; CALL MOVE_ALLOC(FROM=n0, TO=n)
955	ELSE; n=nam(1:1); END IF
956	END SUBROUTINE append
957
958	END FUNCTION dispTraSection
959	!==============================================================================================================================
960
961
962	!==============================================================================================================================
963	!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
964	!==============================================================================================================================
965	LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr) !=== TRACER NAMED "tname" - SCALAR
966	CHARACTER(LEN=*), INTENT(IN) :: tname
967	TYPE(keys_type), TARGET, INTENT(IN) :: trac(:)
968	TYPE(keys_type), POINTER, INTENT(OUT) :: alias
969	INTEGER :: it
970	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
971	alias => NULL()
972	lerr = getKey('name', tnames, trac(:))
973	it = strIdx(tnames, tname)
974	lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
975	END FUNCTION aliasTracer
976	!==============================================================================================================================
977	LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr) !=== TRACERS WITH INDICES "idx(:)" - VECTOR
978	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
979	INTEGER, INTENT(IN) :: idx(:)
980	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
981	alias = trac(idx)
982	lerr = indexUpdate(alias)
983	END FUNCTION trSubset_Indx
984	!------------------------------------------------------------------------------------------------------------------------------
985	LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr) !=== TRACERS NAMED "tname(:)" - VECTOR
986	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
987	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
988	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
989	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
990	lerr = getKey('name', tnames, trac(:))
991	alias = trac(strIdx(tnames, tname))
992	lerr = indexUpdate(alias)
993	END FUNCTION trSubset_Name
994	!==============================================================================================================================
995	LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr) !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
996	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
997	CHARACTER(LEN=*), INTENT(IN) :: gen0Nm
998	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
999	CHARACTER(LEN=maxlen), ALLOCATABLE :: gen0N(:)
1000	lerr = getKey('gen0Name', gen0N, trac(:))
1001	alias = trac(strFind(delPhase(gen0N), gen0Nm))
1002	lerr = indexUpdate(alias)
1003	END FUNCTION trSubset_gen0Name
1004	!==============================================================================================================================
1005
1006
1007	!==============================================================================================================================
1008	!=== UPDATE THE INDEXES iqParent, iqDescen, nqDescen, nqChildren IN THE TRACERS DESCRIPTOR LIST "tr" ==========================
1009	!==============================================================================================================================
1010	LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
1011	TYPE(keys_type), INTENT(INOUT) :: tr(:)
1012	INTEGER :: iq, jq, nq, ig, nGen
1013	INTEGER, ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
1014	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:), parent(:)
1015	INTEGER, DIMENSION(SIZE(tr)) :: iqParent, iGen
1016	lerr = getKey('name', tnames, tr); IF(lerr) RETURN !--- Names
1017	lerr = getKey('parent', parent, tr); IF(lerr) RETURN !--- Parents
1018	nq = SIZE(tr)
1019
1020	!=== iqParent
1021	DO iq = 1, nq; iGen(iq) = 0; jq = iq
1022	iqParent(iq) = strIdx(tnames, parent(iq))
1023	DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
1024	CALL addKey('iqParent', iqParent(iq), tr(iq))
1025	END DO
1026
1027	!=== nqChildren, iqDescen, nqDescen
1028	nGen = MAXVAL(iGen, MASK=.TRUE.)
1029	DO iq = 1, nq
1030	ix = [iq]; ALLOCATE(iqDescen(0))
1031	CALL addKey('nqChildren', 0, tr(iq))
1032	DO ig = iGen(iq)+1, nGen
1033	iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
1034	IF(ig /= iGen(iq)+1) CYCLE
1035	CALL addKey('nqChildren', SIZE(iqDescen), tr(iq))
1036	END DO
1037	CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq))
1038	CALL addKey('nqDescen', SIZE(iqDescen), tr(iq))
1039	DEALLOCATE(iqDescen)
1040	END DO
1041	END FUNCTION indexUpdate
1042	!==============================================================================================================================
1043
1044
1045	!==============================================================================================================================
1046	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS ISOTOPES CLASSES IN "isot(:)%name": ====
1047	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%name" ====
1048	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
1049	!=== NOTES: ====
1050	!=== * Most of the "isot" components have been defined in the calling routine (processIsotopes): ====
1051	!=== name, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
1052	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
1053	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
1054	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
1055	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
1056	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
1057	!==============================================================================================================================
1058	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
1059	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
1060	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %name must be defined!)
1061	LOGICAL :: lFound
1062	INTEGER :: is, iis, it, idb, ndb, nb0
1063	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:), tname(:), iname(:)
1064	CHARACTER(LEN=maxlen) :: modname
1065	TYPE(keys_type), POINTER :: t
1066	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
1067	modname = 'readIsotopesFile'
1068
1069	!--- THE INPUT FILE MUST BE PRESENT
1070	INQUIRE(FILE=TRIM(fnam), EXIST=lFound)
1071	lerr = .NOT.lFound
1072	CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)
1073	IF(lerr) RETURN
1074
1075	!--- READ THE FILE SECTIONS, ONE EACH ISOTOPES CLASS (FIEDL %name)
1076	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
1077	lerr = readSections(fnam,strStack(isot(:)%name,'\|')); IF(lerr) RETURN !--- Read sections, one each isotopes class %name
1078	ndb = SIZE(dBase, DIM=1) !--- Current database size
1079	DO idb = nb0, ndb
1080	iis = idb-nb0+1
1081
1082	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
1083	! lerr = addKeysFromDef(dBase(idb)%trac, 'params'); IF(lerr) RETURN
1084
1085	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
1086	lerr = subDefault(dBase(idb)%trac, 'params', .TRUE.); IF(lerr) RETURN
1087
1088	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
1089	lerr = getKey('name', tname, dBase(idb)%trac); IF(lerr) RETURN
1090	lerr = getKey('name', iname, isot(iis)%keys); IF(lerr) RETURN
1091	DO it = 1, SIZE(dBase(idb)%trac)
1092	t => dBase(idb)%trac(it)
1093	is = strIdx(iname, tname(it)) !--- Index in "iname(:)" of isotope "tname(it)"
1094	IF(is == 0) CYCLE
1095	lerr = ANY(reduceExpr(t%val, vals)); IF(lerr) RETURN !--- Reduce expressions ; detect non-numerical elements
1096	isot(iis)%keys(is)%key = t%key
1097	isot(iis)%keys(is)%val = vals
1098	END DO
1099
1100	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
1101	lerr = checkList(iname, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
1102	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
1103	IF(lerr) RETURN
1104	END DO
1105
1106	!--- CLEAN THE DATABASE ENTRIES
1107	IF(nb0 == 1) THEN
1108	DEALLOCATE(dBase); ALLOCATE(dBase(0))
1109	ELSE
1110	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
1111	END IF
1112
1113	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
1114	CALL get_in('ok_iso_verif', isot(strIdx(iname, 'H2O'))%check, .FALSE.)
1115
1116	lerr = dispIsotopes()
1117
1118	CONTAINS
1119
1120	!------------------------------------------------------------------------------------------------------------------------------
1121	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
1122	INTEGER :: ik, nk, ip, it, nt
1123	CHARACTER(LEN=maxlen) :: prf
1124	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:), tname(:)
1125	CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
1126	DO ip = 1, SIZE(isot) !--- Loop on isotopes classes
1127	IF(SIZE(isot(ip)%keys) == 0) CYCLE
1128	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
1129	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
1130	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
1131	ALLOCATE(ttl(nk+2), val(nt,nk+1))
1132	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
1133	lerr = getKey('name', tname, isot(ip)%keys); IF(lerr) RETURN
1134	val(:,1) = tname !--- Values table 1st column: isotopes names
1135	DO ik = 1, nk
1136	DO it = 1, nt
1137	val(it,ik+1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
1138	END DO
1139	END DO
1140	lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
1141	IF(fmsg('Problem with the table content', modname, lerr)) RETURN
1142	DEALLOCATE(ttl, val)
1143	END DO
1144	END FUNCTION dispIsotopes
1145	!------------------------------------------------------------------------------------------------------------------------------
1146
1147	END FUNCTION readIsotopesFile
1148	!==============================================================================================================================
1149
1150
1151	!==============================================================================================================================
1152	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
1153	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
1154	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS (defined by "keys(:)") ===
1155	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) /!\ DISABLED FUNCTION /!\ ===
1156	!==============================================================================================================================
1157	LOGICAL FUNCTION processIsotopes(keys, isot, iClasses) RESULT(lerr)
1158	TYPE(keys_type), TARGET, OPTIONAL, INTENT(INOUT) :: keys(:)
1159	TYPE(isot_type), TARGET, ALLOCATABLE, OPTIONAL, INTENT(OUT) :: isot(:)
1160	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: iClasses(:)
1161	CHARACTER(LEN=maxlen), ALLOCATABLE :: str1(:), str2(:) !--- Temporary storage
1162	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:), iCla(:)
1163	CHARACTER(LEN=maxlen) :: iClass, modname
1164	CHARACTER(LEN=1) :: ph !--- Phase
1165	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
1166	INTEGER, ALLOCATABLE :: iGen(:)
1167	INTEGER :: ic, ip, iq, ii, it, iz
1168	TYPE(isot_type), POINTER :: i1
1169	TYPE(keys_type), POINTER :: k(:)
1170
1171	lerr = .FALSE.
1172	modname = 'readIsotopesFile'
1173	k => tracers; IF(PRESENT(keys )) k => keys
1174	lerr = getKey('name', tname, k); IF(lerr) RETURN !--- Names
1175	lerr = getKey('parent', parent, k); IF(lerr) RETURN !--- Parents
1176	lerr = getKey('type', dType, k); IF(lerr) RETURN !--- Tracer type
1177	lerr = getKey('phase', phase, k); IF(lerr) RETURN !--- Phase
1178	lerr = getKey('gen0Name', gen0N, k); IF(lerr) RETURN !--- 1st generation ancestor name
1179	lerr = getKey('iGeneration', iGen, k); IF(lerr) RETURN !--- Generation number
1180
1181	!--- INITIALIZATION IF ISOTOPES-SPECIFIC KEYS (MUST BE DEFINED EVEN WITHOUT ISOTOPES)
1182	DO iq = 1, SIZE(k)
1183	CALL addKey('iso_iGroup',0, k(iq)) !--- Family idx in list "isotopes(:)%parent"
1184	CALL addKey('iso_iName', 0, k(iq)) !--- Isotope idx in effective isotopes list
1185	CALL addKey('iso_iZone', 0, k(iq)) !--- Tagging zone idx in effective zones list
1186	CALL addKey('iso_iPhas', 0, k(iq)) !--- Phase idx in effective phases list
1187	END DO
1188
1189	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
1190	iCla = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
1191	CALL strReduce(iCla)
1192
1193	!--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iClasses" ARE AVAILABLE OR NOT
1194	IF(PRESENT(iClasses)) THEN
1195	DO it = 1, SIZE(iClasses)
1196	lerr = ALL(iCla /= iClasses(it))
1197	IF(fmsg('No isotopes class "'//TRIM(iClasses(it))//'" found among tracers', modname, lerr)) RETURN
1198	END DO
1199	iCla = iClasses
1200	END IF
1201	nbIso = SIZE(iCla)
1202
1203	!--- USE THE ARGUMENT "isot" TO STORE THE ISOTOPIC DATABASE OR THE LOCAL VECTOR "isotopes"
1204	IF(PRESENT(isot)) THEN
1205	ALLOCATE( isot(nbIso))
1206	ELSE
1207	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
1208	ALLOCATE(isotopes(nbIso))
1209	END IF
1210	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
1211
1212	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
1213	DO ic = 1, nbIso !--- Loop on isotopes classes
1214	IF( PRESENT(isot)) i1 => isot (ic)
1215	IF(.NOT.PRESENT(isot)) i1 => isotopes(ic)
1216	iClass = iCla(ic) !--- Current isotopes class name (parent tracer name)
1217	i1%name = iClass
1218
1219	!=== Isotopes children of tracer "iClass": mask, names, number (same for each phase of "iClass")
1220	ll = dType=='tracer' .AND. delPhase(parent) == iClass .AND. phase == 'g'
1221	str1 = PACK(delPhase(tname), MASK = ll) !--- Effectively found isotopes of "iClass"
1222	i1%niso = SIZE(str1) !--- Number of "effectively found isotopes of "iname"
1223	ALLOCATE(i1%keys(i1%niso))
1224	DO it = 1, i1%niso; CALL addKey('name', str1(it), i1%keys(it)); END DO
1225
1226	!=== Geographic tagging tracers descending on tracer "iClass": mask, names, number
1227	ll = dType=='tag' .AND. delPhase(gen0N) == iClass .AND. iGen == 2
1228	i1%zone = PACK(strTail(tname, '_', .TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
1229	CALL strReduce(i1%zone)
1230	i1%nzone = SIZE(i1%zone) !--- Tagging zones number for isotopes category "iClass"
1231
1232	!=== Geographic tracers of the isotopes children of tracer "iClass" (same for each phase of "iClass")
1233	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
1234	str2 = PACK(delPhase(tname), MASK=ll)
1235	CALL strReduce(str2)
1236	i1%ntiso = i1%niso + SIZE(str2) !--- Number of isotopes + their geographic tracers [ntiso]
1237	ALLOCATE(i1%trac(i1%ntiso))
1238	DO it = 1, i1%niso; i1%trac(it) = str1(it); END DO
1239	DO it = i1%niso+1, i1%ntiso; i1%trac(it) = str2(it-i1%niso); END DO
1240
1241	!=== Phases for tracer "iClass"
1242	i1%phase = ''
1243	DO ip = 1, nphases; ph = known_phases(ip:ip); IF(ANY(tname == addPhase(iClass, ph))) i1%phase = TRIM(i1%phase)//ph; END DO
1244	i1%nphas = LEN_TRIM(i1%phase) !--- Equal to "nqo" for water
1245
1246	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
1247	DO iq = 1, SIZE(tracers)
1248	ii = strIdx(i1%trac, strHead(delPhase(tname(iq)), '_', .TRUE.))
1249	iz = strIdx(i1%zone, strTail( tname(iq), '_', .TRUE.))
1250	ip = INDEX(i1%phase, TRIM(phase(iq) ))
1251	IF(delPhase(gen0N(iq)) /= iClass .OR. iGen(iq) == 0) CYCLE !--- Only deal with tracers descending on "iClass"
1252	CALL addKey('iso_iGroup',ic, k(iq)) !--- Family idx in list "isotopes(:)%name"
1253	CALL addKey('iso_iName', ii, k(iq)) !--- Isotope idx in effective isotopes list
1254	CALL addKey('iso_iZone', iz, k(iq)) !--- Tagging zone idx in effective zones list
1255	CALL addKey('iso_iPhas', ip, k(iq)) !--- Phase idx in effective phases list
1256	IF(iGen(iq) /= 2) CALL addKey('iso_iZone', 0, k(iq)) !--- Skip possible generation 1 tagging tracers
1257	END DO
1258
1259	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
1260	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1261	i1%iqIsoPha = RESHAPE( [( (strIdx(tname, addPhase(i1%trac(it),i1%phase(ip:ip))), it=1, i1%ntiso), ip=1, i1%nphas)], &
1262	[i1%ntiso, i1%nphas] )
1263	!=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
1264	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1265	i1%iqWIsoPha = RESHAPE( [( [strIdx(tname, addPhase('H2O', i1%phase(ip:ip))), i1%iqIsoPha(:,ip)], ip=1, i1%nphas)], &
1266	[1+i1%ntiso, i1%nphas] )
1267	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
1268	i1%itZonIso = RESHAPE( [( (strIdx(i1%trac(:), TRIM(i1%trac(it))//'_'//TRIM(i1%zone(iz))), iz=1, i1%nzone), it=1, i1%niso )], &
1269	[i1%nzone, i1%niso] )
1270	END DO
1271
1272	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE (COMMENTED => DISABLED)
1273	! IF( PRESENT(isot)) lerr = readIsotopesFile(isoFile, isot)
1274	! IF(.NOT.PRESENT(isot)) lerr = readIsotopesFile(isoFile, isotopes)
1275	! IF(lerr) RETURN
1276
1277	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
1278	CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
1279
1280	!=== CHECK CONSISTENCY
1281	lerr = testIsotopes(); IF(lerr) RETURN
1282
1283	!=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
1284	IF(isoSelect('H2O', lVerbose=.TRUE.)) THEN
1285	iH2O = ixIso
1286	ELSE
1287	lerr = isoSelect(1, lVerbose=.TRUE.)
1288	END IF
1289
1290	CONTAINS
1291
1292	!------------------------------------------------------------------------------------------------------------------------------
1293	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
1294	!------------------------------------------------------------------------------------------------------------------------------
1295	INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
1296	DO ix = 1, nbIso
1297	IF( PRESENT(isot)) i1 => isot (ix)
1298	IF(.NOT.PRESENT(isot)) i1 => isotopes(ix)
1299	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
1300	DO it = 1, i1%ntiso; npha = i1%nphas
1301	np = SUM([(COUNT(tname(:) == addPhase(i1%trac(it), i1%phase(ip:ip))), ip=1, npha)])
1302	lerr = np /= npha
1303	CALL msg(TRIM(int2str(np))// ' phases instead of '//TRIM(int2str(npha))//' for '//TRIM(i1%trac(it)), modname, lerr)
1304	IF(lerr) RETURN
1305	END DO
1306	DO it = 1, i1%niso; nzon = i1%nzone
1307	nz = SUM([(COUNT(i1%trac == TRIM(i1%trac(it))//'_'//i1%zone(iz)), iz=1, nzon)])
1308	lerr = nz /= nzon
1309	CALL msg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(nzon))//' for '//TRIM(i1%trac(it)), modname, lerr)
1310	IF(lerr) RETURN
1311	END DO
1312	END DO
1313	END FUNCTION testIsotopes
1314	!------------------------------------------------------------------------------------------------------------------------------
1315
1316	END FUNCTION processIsotopes
1317	!==============================================================================================================================
1318
1319
1320	!==============================================================================================================================
1321	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
1322	! Single generic "isoSelect" routine, using the predefined index of the class (fast version) or its name (first call).
1323	!==============================================================================================================================
1324	LOGICAL FUNCTION isoSelectByName(iClass, isot, lVerbose) RESULT(lerr)
1325	IMPLICIT NONE
1326	CHARACTER(LEN=*), INTENT(IN) :: iClass
1327	TYPE(isot_type), OPTIONAL, TARGET, INTENT(IN) :: isot(:)
1328	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1329	TYPE(isot_type), POINTER :: iso(:)
1330	INTEGER :: iIso
1331	LOGICAL :: lV
1332	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
1333	iso => isotopes; IF(PRESENT(isot)) iso => isot
1334	iIso = strIdx(iso(:)%name, iClass)
1335	lerr = iIso == 0
1336	IF(lerr) THEN
1337	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
1338	CALL msg('no isotope family named "'//TRIM(iClass)//'"', ll=lV)
1339	RETURN
1340	END IF
1341	lerr = isoSelectByIndex(iIso, iso, lV)
1342	END FUNCTION isoSelectByName
1343	!==============================================================================================================================
1344	LOGICAL FUNCTION isoSelectByIndex(iIso, isot, lVerbose) RESULT(lerr)
1345	IMPLICIT NONE
1346	INTEGER, INTENT(IN) :: iIso
1347	TYPE(isot_type), TARGET, OPTIONAL, INTENT(INOUT) :: isot(:)
1348	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1349	TYPE(isot_type), POINTER :: i(:)
1350	LOGICAL :: lV
1351	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
1352	i => isotopes; IF(PRESENT(isot)) i => isot
1353	lerr = .FALSE.
1354	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
1355	lerr = iIso<=0 .OR. iIso>SIZE(i)
1356	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
1357	//TRIM(int2str(SIZE(i)))//'"', ll = lerr .AND. lV)
1358	IF(lerr) RETURN
1359	ixIso = iIso !--- Update currently selected family index
1360	isotope => i(ixIso) !--- Select corresponding component
1361	isoKeys => isotope%keys; niso = isotope%niso
1362	isoName => isotope%trac; ntiso = isotope%ntiso
1363	isoZone => isotope%zone; nzone = isotope%nzone
1364	isoPhas => isotope%phase; nphas = isotope%nphas
1365	itZonIso => isotope%itZonIso; isoCheck = isotope%check
1366	iqIsoPha => isotope%iqIsoPha
1367	iqWIsoPha=> isotope%iqWIsoPha
1368	END FUNCTION isoSelectByIndex
1369	!==============================================================================================================================
1370
1371
1372	!==============================================================================================================================
1373	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
1374	!==============================================================================================================================
1375	SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
1376	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1377	TYPE(keys_type), INTENT(INOUT) :: ky
1378	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1379	!------------------------------------------------------------------------------------------------------------------------------
1380	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1381	INTEGER :: iky, nky
1382	LOGICAL :: lo
1383	lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
1384	IF(.NOT.ALLOCATED(ky%key)) THEN
1385	ALLOCATE(ky%key(1)); ky%key(1)=key
1386	ALLOCATE(ky%val(1)); ky%val(1)=sval
1387	RETURN
1388	END IF
1389	iky = strIdx(ky%key,key)
1390	IF(iky == 0) THEN
1391	nky = SIZE(ky%key)
1392	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
1393	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
1394	ELSE IF(lo) THEN
1395	ky%key(iky) = key; ky%val(iky) = sval
1396	END IF
1397	END SUBROUTINE addKey_s11
1398	!==============================================================================================================================
1399	SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
1400	CHARACTER(LEN=*), INTENT(IN) :: key
1401	INTEGER, INTENT(IN) :: ival
1402	TYPE(keys_type), INTENT(INOUT) :: ky
1403	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1404	!------------------------------------------------------------------------------------------------------------------------------
1405	CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
1406	END SUBROUTINE addKey_i11
1407	!==============================================================================================================================
1408	SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
1409	CHARACTER(LEN=*), INTENT(IN) :: key
1410	REAL, INTENT(IN) :: rval
1411	TYPE(keys_type), INTENT(INOUT) :: ky
1412	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1413	!------------------------------------------------------------------------------------------------------------------------------
1414	CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
1415	END SUBROUTINE addKey_r11
1416	!==============================================================================================================================
1417	SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
1418	CHARACTER(LEN=*), INTENT(IN) :: key
1419	LOGICAL, INTENT(IN) :: lval
1420	TYPE(keys_type), INTENT(INOUT) :: ky
1421	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1422	!------------------------------------------------------------------------------------------------------------------------------
1423	CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
1424	END SUBROUTINE addKey_l11
1425	!==============================================================================================================================
1426	!==============================================================================================================================
1427	SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
1428	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1429	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1430	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1431	!------------------------------------------------------------------------------------------------------------------------------
1432	INTEGER :: itr
1433	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
1434	END SUBROUTINE addKey_s1m
1435	!==============================================================================================================================
1436	SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
1437	CHARACTER(LEN=*), INTENT(IN) :: key
1438	INTEGER, INTENT(IN) :: ival
1439	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1440	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1441	!------------------------------------------------------------------------------------------------------------------------------
1442	INTEGER :: itr
1443	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite); END DO
1444	END SUBROUTINE addKey_i1m
1445	!==============================================================================================================================
1446	SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
1447	CHARACTER(LEN=*), INTENT(IN) :: key
1448	REAL, INTENT(IN) :: rval
1449	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1450	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1451	!------------------------------------------------------------------------------------------------------------------------------
1452	INTEGER :: itr
1453	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite); END DO
1454	END SUBROUTINE addKey_r1m
1455	!==============================================================================================================================
1456	SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
1457	CHARACTER(LEN=*), INTENT(IN) :: key
1458	LOGICAL, INTENT(IN) :: lval
1459	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1460	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1461	!------------------------------------------------------------------------------------------------------------------------------
1462	INTEGER :: itr
1463	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite); END DO
1464	END SUBROUTINE addKey_l1m
1465	!==============================================================================================================================
1466	!==============================================================================================================================
1467	SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
1468	CHARACTER(LEN=*), INTENT(IN) :: key, sval(:)
1469	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1470	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1471	!------------------------------------------------------------------------------------------------------------------------------
1472	INTEGER :: itr
1473	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
1474	END SUBROUTINE addKey_smm
1475	!==============================================================================================================================
1476	SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
1477	CHARACTER(LEN=*), INTENT(IN) :: key
1478	INTEGER, INTENT(IN) :: ival(:)
1479	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1480	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1481	!------------------------------------------------------------------------------------------------------------------------------
1482	INTEGER :: itr
1483	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
1484	END SUBROUTINE addKey_imm
1485	!==============================================================================================================================
1486	SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
1487	CHARACTER(LEN=*), INTENT(IN) :: key
1488	REAL, INTENT(IN) :: rval(:)
1489	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1490	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1491	!------------------------------------------------------------------------------------------------------------------------------
1492	INTEGER :: itr
1493	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
1494	END SUBROUTINE addKey_rmm
1495	!==============================================================================================================================
1496	SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
1497	CHARACTER(LEN=*), INTENT(IN) :: key
1498	LOGICAL, INTENT(IN) :: lval(:)
1499	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1500	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1501	!------------------------------------------------------------------------------------------------------------------------------
1502	INTEGER :: itr
1503	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
1504	END SUBROUTINE addKey_lmm
1505	!==============================================================================================================================
1506
1507
1508	!==============================================================================================================================
1509	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
1510	!==============================================================================================================================
1511	LOGICAL FUNCTION addKeysFromDef(t, tr0) RESULT(lerr)
1512	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
1513	CHARACTER(LEN=*), INTENT(IN) :: tr0
1514	!------------------------------------------------------------------------------------------------------------------------------
1515	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
1516	CHARACTER(LEN=maxlen) :: val
1517	INTEGER :: ik, jd
1518	lerr = getKey('name', tname, t); IF(lerr) RETURN
1519	jd = strIdx(tname(:), tr0)
1520	IF(jd == 0) RETURN
1521	DO ik = 1, SIZE(t(jd)%key)
1522	CALL get_in(t(jd)%key(ik), val, 'none')
1523	IF(val /= 'none') CALL addKey(t(jd)%key(ik), val, t(jd), .TRUE.)
1524	END DO
1525	END FUNCTION addKeysFromDef
1526	!==============================================================================================================================
1527
1528
1529	!==============================================================================================================================
1530	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
1531	!==============================================================================================================================
1532	SUBROUTINE delKey_1(itr, keyn, ky)
1533	INTEGER, INTENT(IN) :: itr
1534	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1535	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1536	!------------------------------------------------------------------------------------------------------------------------------
1537	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1538	LOGICAL, ALLOCATABLE :: ll(:)
1539	INTEGER :: iky
1540	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
1541	ll = [( ALL(keyn/=ky(itr)%key(iky)), iky=1, SIZE(ky(itr)%key) )]
1542	k = PACK(ky(itr)%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%key)
1543	v = PACK(ky(itr)%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%val)
1544	END SUBROUTINE delKey_1
1545	!==============================================================================================================================
1546	SUBROUTINE delKey(keyn, ky)
1547	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1548	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1549	!------------------------------------------------------------------------------------------------------------------------------
1550	INTEGER :: iky
1551	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
1552	END SUBROUTINE delKey
1553	!==============================================================================================================================
1554
1555
1556	!==============================================================================================================================
1557	!=== INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT ===
1558	!=== IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER ===
1559	!==============================================================================================================================
1560	CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
1561	INTEGER, INTENT(IN) :: itr
1562	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1563	TYPE(keys_type), INTENT(IN) :: ky(:)
1564	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1565	!------------------------------------------------------------------------------------------------------------------------------
1566	INTEGER :: ik
1567	LOGICAL :: ler
1568	ler = .TRUE.
1569	DO ik = 1, SIZE(keyn)
1570	CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
1571	END DO
1572	IF(PRESENT(lerr)) lerr = ler
1573
1574	CONTAINS
1575
1576	SUBROUTINE getKeyIdx(keyn)
1577	CHARACTER(LEN=*), INTENT(IN) :: keyn
1578	!------------------------------------------------------------------------------------------------------------------------------
1579	INTEGER :: iky
1580	iky = 0; val = ''
1581	ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
1582	iky = strIdx(ky(itr)%key(:), keyn)
1583	ler = iky == 0; IF(ler) RETURN
1584	val = ky(itr)%val(iky)
1585	END SUBROUTINE getKeyIdx
1586
1587	END FUNCTION fgetKeyIdx
1588	!==============================================================================================================================
1589
1590
1591	!==============================================================================================================================
1592	!=== GET KEYS VALUES FROM TRACERS INDICES ===
1593	!==============================================================================================================================
1594	!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN: ===
1595	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
1596	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
1597	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
1598	!=== * A SCALAR ===
1599	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
1600	!=== ===
1601	!=== SYNTAX: lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)] [, def][, lDisp]) ===
1602	!==============================================================================================================================
1603	!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)" ===
1604	!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)" ===
1605	!=== SYNTAX lerr = getKeyByIndex_{sirl}{1m}mm (keyn[(:)], val (:) [, ky(:)][, nam(:)][, def][, lDisp]) ===
1606	!==============================================================================================================================
1607	LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1608	CHARACTER(LEN=*), INTENT(IN) :: keyn
1609	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1610	INTEGER, INTENT(IN) :: itr
1611	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1612	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
1613	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1614	lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
1615	END FUNCTION getKeyByIndex_s111
1616	!==============================================================================================================================
1617	LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1618	CHARACTER(LEN=*), INTENT(IN) :: keyn
1619	INTEGER, INTENT(OUT) :: val
1620	INTEGER, INTENT(IN) :: itr
1621	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1622	INTEGER, OPTIONAL, INTENT(IN) :: def
1623	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1624	lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
1625	END FUNCTION getKeyByIndex_i111
1626	!==============================================================================================================================
1627	LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1628	CHARACTER(LEN=*), INTENT(IN) :: keyn
1629	REAL , INTENT(OUT) :: val
1630	INTEGER, INTENT(IN) :: itr
1631	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1632	REAL, OPTIONAL, INTENT(IN) :: def
1633	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1634	lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
1635	END FUNCTION getKeyByIndex_r111
1636	!==============================================================================================================================
1637	LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1638	CHARACTER(LEN=*), INTENT(IN) :: keyn
1639	LOGICAL, INTENT(OUT) :: val
1640	INTEGER, INTENT(IN) :: itr
1641	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1642	LOGICAL, OPTIONAL, INTENT(IN) :: def
1643	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1644	lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
1645	END FUNCTION getKeyByIndex_l111
1646	!==============================================================================================================================
1647	!==============================================================================================================================
1648	LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1649	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1650	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1651	INTEGER, INTENT(IN) :: itr
1652	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1653	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
1654	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1655	!------------------------------------------------------------------------------------------------------------------------------
1656	CHARACTER(LEN=maxlen) :: s
1657	LOGICAL :: lD
1658	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
1659	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(int2str(itr))
1660	lerr = .TRUE.
1661	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
1662	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)) !--- "tracers"
1663	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
1664	IF(lerr .AND. PRESENT(def)) THEN
1665	val = def; lerr = .NOT.PRESENT(def)
1666	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
1667	END IF
1668	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
1669
1670	CONTAINS
1671
1672	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
1673	TYPE(keys_type), INTENT(IN) :: ky(:)
1674	lerr = SIZE(ky) == 0; IF(lerr) RETURN
1675	val = fgetKeyIdx(itr, keyn(:), ky, lerr)
1676	END FUNCTION fgetKey
1677
1678	END FUNCTION getKeyByIndex_sm11
1679	!==============================================================================================================================
1680	LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1681	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1682	INTEGER, INTENT(OUT) :: val
1683	INTEGER, INTENT(IN) :: itr
1684	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1685	INTEGER, OPTIONAL, INTENT(IN) :: def
1686	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1687	!------------------------------------------------------------------------------------------------------------------------------
1688	CHARACTER(LEN=maxlen) :: sval, s
1689	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
1690	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1691	IF(lerr) RETURN
1692	val = str2int(sval)
1693	lerr = val == -HUGE(1)
1694	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1695	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1696	END FUNCTION getKeyByIndex_im11
1697	!==============================================================================================================================
1698	LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1699	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1700	REAL , INTENT(OUT) :: val
1701	INTEGER, INTENT(IN) :: itr
1702	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1703	REAL, OPTIONAL, INTENT(IN) :: def
1704	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1705	!------------------------------------------------------------------------------------------------------------------------------
1706	CHARACTER(LEN=maxlen) :: sval, s
1707	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
1708	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1709	IF(lerr) RETURN
1710	val = str2real(sval)
1711	lerr = val == -HUGE(1.)
1712	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1713	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1714	END FUNCTION getKeyByIndex_rm11
1715	!==============================================================================================================================
1716	LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1717	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1718	LOGICAL, INTENT(OUT) :: val
1719	INTEGER, INTENT(IN) :: itr
1720	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1721	LOGICAL, OPTIONAL, INTENT(IN) :: def
1722	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1723	!------------------------------------------------------------------------------------------------------------------------------
1724	CHARACTER(LEN=maxlen) :: sval, s
1725	INTEGER :: ival
1726	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
1727	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1728	IF(lerr) RETURN
1729	ival = str2bool(sval)
1730	lerr = ival == -1
1731	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1732	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1733	IF(.NOT.lerr) val = ival == 1
1734	END FUNCTION getKeyByIndex_lm11
1735	!==============================================================================================================================
1736	!==============================================================================================================================
1737	LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1738	CHARACTER(LEN=*), INTENT(IN) :: keyn
1739	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1740	INTEGER, INTENT(IN) :: itr
1741	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1742	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1743	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1744	!------------------------------------------------------------------------------------------------------------------------------
1745	CHARACTER(LEN=maxlen) :: sval
1746	lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
1747	lerr = strParse(sval, ',', val)
1748	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1749	END FUNCTION getKeyByIndex_s1m1
1750	!==============================================================================================================================
1751	LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1752	CHARACTER(LEN=*), INTENT(IN) :: keyn
1753	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1754	INTEGER, INTENT(IN) :: itr
1755	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1756	INTEGER, OPTIONAL, INTENT(IN) :: def
1757	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1758	!------------------------------------------------------------------------------------------------------------------------------
1759	CHARACTER(LEN=maxlen) :: sval, s
1760	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1761	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
1762	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1763	IF(lerr) RETURN
1764	lerr = strParse(sval, ',', svals)
1765	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1766	val = str2int(svals)
1767	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
1768	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1769	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1770	END FUNCTION getKeyByIndex_i1m1
1771	!==============================================================================================================================
1772	LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1773	CHARACTER(LEN=*), INTENT(IN) :: keyn
1774	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1775	INTEGER, INTENT(IN) :: itr
1776	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1777	REAL, OPTIONAL, INTENT(IN) :: def
1778	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1779	!------------------------------------------------------------------------------------------------------------------------------
1780	CHARACTER(LEN=maxlen) :: sval, s
1781	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1782	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
1783	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1784	lerr = strParse(sval, ',', svals)
1785	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1786	val = str2real(svals)
1787	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
1788	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1789	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1790	END FUNCTION getKeyByIndex_r1m1
1791	!==============================================================================================================================
1792	LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1793	CHARACTER(LEN=*), INTENT(IN) :: keyn
1794	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1795	INTEGER, INTENT(IN) :: itr
1796	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1797	LOGICAL, OPTIONAL, INTENT(IN) :: def
1798	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1799	!------------------------------------------------------------------------------------------------------------------------------
1800	CHARACTER(LEN=maxlen) :: sval, s
1801	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1802	INTEGER, ALLOCATABLE :: ivals(:)
1803	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
1804	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1805	lerr = strParse(sval, ',', svals)
1806	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1807	ivals = str2bool(svals)
1808	lerr = ANY(ivals == -1) .AND. sval /= ''
1809	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1810	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1811	IF(.NOT.lerr) val = ivals == 1
1812	END FUNCTION getKeyByIndex_l1m1
1813	!==============================================================================================================================
1814	!==============================================================================================================================
1815	LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1816	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1817	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1818	INTEGER, INTENT(IN) :: itr
1819	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1820	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1821	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1822	!------------------------------------------------------------------------------------------------------------------------------
1823	CHARACTER(LEN=maxlen) :: sval
1824	lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
1825	lerr = strParse(sval, ',', val)
1826	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1827	END FUNCTION getKeyByIndex_smm1
1828	!==============================================================================================================================
1829	LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1830	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1831	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1832	INTEGER, INTENT(IN) :: itr
1833	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1834	INTEGER, OPTIONAL, INTENT(IN) :: def
1835	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1836	!------------------------------------------------------------------------------------------------------------------------------
1837	CHARACTER(LEN=maxlen) :: sval, s
1838	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1839	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
1840	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1841	IF(lerr) RETURN
1842	lerr = strParse(sval, ',', svals)
1843	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1844	val = str2int(svals)
1845	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
1846	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1847	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1848	END FUNCTION getKeyByIndex_imm1
1849	!==============================================================================================================================
1850	LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1851	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1852	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1853	INTEGER, INTENT(IN) :: itr
1854	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1855	REAL, OPTIONAL, INTENT(IN) :: def
1856	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1857	!------------------------------------------------------------------------------------------------------------------------------
1858	CHARACTER(LEN=maxlen) :: sval, s
1859	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1860	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
1861	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1862	IF(lerr) RETURN
1863	lerr = strParse(sval, ',', svals)
1864	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1865	val = str2real(svals)
1866	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
1867	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1868	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1869	END FUNCTION getKeyByIndex_rmm1
1870	!==============================================================================================================================
1871	LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1872	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1873	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1874	INTEGER, INTENT(IN) :: itr
1875	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1876	LOGICAL, OPTIONAL, INTENT(IN) :: def
1877	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1878	!------------------------------------------------------------------------------------------------------------------------------
1879	CHARACTER(LEN=maxlen) :: sval, s
1880	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1881	INTEGER, ALLOCATABLE :: ivals(:)
1882	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
1883	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1884	IF(lerr) RETURN
1885	lerr = strParse(sval, ',', svals)
1886	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
1887	ivals = str2bool(svals)
1888	lerr = ANY(ivals == -1) .AND. sval /= ''
1889	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
1890	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1891	IF(.NOT.lerr) val = ivals == 1
1892	END FUNCTION getKeyByIndex_lmm1
1893	!==============================================================================================================================
1894	!==============================================================================================================================
1895	LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
1896	CHARACTER(LEN=*), INTENT(IN) :: keyn
1897	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1898	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1899	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1900	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1901	lerr = getKeyByIndex_smmm([keyn], val, ky, def, lDisp)
1902	END FUNCTION getKeyByIndex_s1mm
1903	!==============================================================================================================================
1904	LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
1905	CHARACTER(LEN=*), INTENT(IN) :: keyn
1906	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1907	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1908	INTEGER, OPTIONAL, INTENT(IN) :: def
1909	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1910	lerr = getKeyByIndex_immm([keyn], val, ky, def, lDisp)
1911	END FUNCTION getKeyByIndex_i1mm
1912	!==============================================================================================================================
1913	LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
1914	CHARACTER(LEN=*), INTENT(IN) :: keyn
1915	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1916	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1917	REAL, OPTIONAL, INTENT(IN) :: def
1918	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1919	lerr = getKeyByIndex_rmmm([keyn], val, ky, def, lDisp)
1920	END FUNCTION getKeyByIndex_r1mm
1921	!==============================================================================================================================
1922	LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
1923	CHARACTER(LEN=*), INTENT(IN) :: keyn
1924	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1925	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1926	LOGICAL, OPTIONAL, INTENT(IN) :: def
1927	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1928	lerr = getKeyByIndex_lmmm([keyn], val, ky, def, lDisp)
1929	END FUNCTION getKeyByIndex_l1mm
1930	!==============================================================================================================================
1931	!==============================================================================================================================
1932	LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, def, lDisp) RESULT(lerr)
1933	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1934	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1935	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1936	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1937	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1938	!------------------------------------------------------------------------------------------------------------------------------
1939	CHARACTER(LEN=maxlen) :: s
1940	INTEGER :: iq, nq(3), k
1941	LOGICAL :: lD, l(3)
1942	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
1943	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
1944	lerr = .TRUE.
1945	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
1946	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)) !--- "tracers"
1947	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
1948	END IF
1949	IF(.NOT.lerr) RETURN
1950	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
1951
1952	!--- DEFAULT VALUE
1953	l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
1954	IF(l(1)) nq(1) = SIZE(ky)
1955	IF(l(2)) nq(2) = SIZE(tracers)
1956	IF(l(3)) nq(3) = SIZE(isotope%keys)
1957	DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
1958	lerr = k == 4
1959	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
1960	CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
1961
1962	CONTAINS
1963
1964	FUNCTION fgetKey(ky) RESULT(val)
1965	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
1966	TYPE(keys_type), INTENT(IN) :: ky(:)
1967	LOGICAL :: ler(SIZE(ky))
1968	INTEGER :: iq
1969	lerr = SIZE(ky) == 0; IF(lerr) RETURN
1970	val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
1971	lerr = ANY(ler)
1972	END FUNCTION fgetKey
1973
1974	END FUNCTION getKeyByIndex_smmm
1975	!==============================================================================================================================
1976	LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, def, lDisp) RESULT(lerr)
1977	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1978	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1979	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1980	INTEGER, OPTIONAL, INTENT(IN) :: def
1981	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1982	!------------------------------------------------------------------------------------------------------------------------------
1983	CHARACTER(LEN=maxlen) :: s
1984	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
1985	LOGICAL, ALLOCATABLE :: ll(:)
1986	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, int2str(def), lDisp)
1987	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
1988	IF(lerr) RETURN
1989	val = str2int(svals)
1990	ll = val == -HUGE(1) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
1991	lerr = ANY(ll); IF(.NOT.lerr) RETURN
1992	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
1993	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
1994	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
1995	END FUNCTION getKeyByIndex_immm
1996	!==============================================================================================================================
1997	LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, def, lDisp) RESULT(lerr)
1998	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1999	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2000	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2001	REAL, OPTIONAL, INTENT(IN) :: def
2002	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2003	!------------------------------------------------------------------------------------------------------------------------------
2004	CHARACTER(LEN=maxlen) :: s
2005	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
2006	LOGICAL, ALLOCATABLE :: ll(:)
2007	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, real2str(def), lDisp)
2008	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
2009	IF(lerr) RETURN
2010	val = str2real(svals)
2011	ll = val == -HUGE(1.) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
2012	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2013	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
2014	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
2015	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
2016	END FUNCTION getKeyByIndex_rmmm
2017	!==============================================================================================================================
2018	LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, def, lDisp) RESULT(lerr)
2019	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
2020	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2021	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2022	LOGICAL, OPTIONAL, INTENT(IN) :: def
2023	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2024	!------------------------------------------------------------------------------------------------------------------------------
2025	CHARACTER(LEN=maxlen) :: s
2026	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
2027	LOGICAL, ALLOCATABLE :: ll(:)
2028	INTEGER, ALLOCATABLE :: ivals(:)
2029	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, bool2str(def), lDisp)
2030	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
2031	IF(lerr) RETURN
2032	ivals = str2bool(svals)
2033	ll = ivals == -1 .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
2034	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2035	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
2036	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2037	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
2038	IF(.NOT.lerr) val = ivals == 1
2039	END FUNCTION getKeyByIndex_lmmm
2040	!==============================================================================================================================
2041
2042
2043
2044	!==============================================================================================================================
2045	!=== GET KEYS VALUES FROM TRACERS NAMES ===
2046	!==============================================================================================================================
2047	!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN: ===
2048	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
2049	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
2050	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
2051	!=== * A SCALAR ===
2052	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
2053	!=== ===
2054	!=== SYNTAX: lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname [, ky(:)][, def][, lDisp]) ===
2055	!==============================================================================================================================
2056	!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)" ===
2057	!=== ===
2058	!=== SYNTAX lerr = getKeyByName_{sirl}{1m}mm (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp]) ===
2059	!==============================================================================================================================
2060	LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2061	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2062	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
2063	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2064	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
2065	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2066	lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
2067	END FUNCTION getKeyByName_s111
2068	!==============================================================================================================================
2069	LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2070	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2071	INTEGER, INTENT(OUT) :: val
2072	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2073	INTEGER, OPTIONAL, INTENT(IN) :: def
2074	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2075	lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
2076	END FUNCTION getKeyByName_i111
2077	!==============================================================================================================================
2078	LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2079	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2080	REAL , INTENT(OUT) :: val
2081	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2082	REAL, OPTIONAL, INTENT(IN) :: def
2083	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2084	lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
2085	END FUNCTION getKeyByName_r111
2086	!==============================================================================================================================
2087	LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2088	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2089	LOGICAL, INTENT(OUT) :: val
2090	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2091	LOGICAL, OPTIONAL, INTENT(IN) :: def
2092	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2093	lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
2094	END FUNCTION getKeyByName_l111
2095	!==============================================================================================================================
2096	!==============================================================================================================================
2097	LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2098	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2099	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
2100	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2101	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
2102	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2103	!------------------------------------------------------------------------------------------------------------------------------
2104	CHARACTER(LEN=maxlen) :: s, tnam
2105	LOGICAL :: lD
2106	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
2107	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
2108	lerr = .TRUE.
2109	tnam = strHead(delPhase(tname),'_',.TRUE.) !--- Remove phase and tag
2110	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
2111	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)) !--- "tracers"
2112	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
2113	IF(lerr .AND. PRESENT(def)) THEN
2114	val = def; lerr = .NOT.PRESENT(def)
2115	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
2116	END IF
2117	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
2118
2119	CONTAINS
2120
2121	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
2122	TYPE(keys_type), INTENT(IN) :: ky(:)
2123	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname_all(:)
2124	lerr = SIZE(ky) == 0; IF(lerr) RETURN
2125	lerr = getKey('name', tname_all, ky); IF(lerr) RETURN
2126	val = fgetKeyIdx(strIdx(tname_all, tname), [keyn], ky, lerr)
2127	IF(lerr) val = fgetKeyIdx(strIdx(tname_all, tnam ), [keyn], ky, lerr)
2128	END FUNCTION fgetKey
2129
2130	END FUNCTION getKeyByName_sm11
2131	!==============================================================================================================================
2132	LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2133	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2134	INTEGER, INTENT(OUT) :: val
2135	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2136	INTEGER, OPTIONAL, INTENT(IN) :: def
2137	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2138	!------------------------------------------------------------------------------------------------------------------------------
2139	CHARACTER(LEN=maxlen) :: sval, s
2140	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
2141	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2142	IF(lerr) RETURN
2143	val = str2int(sval)
2144	lerr = val == -HUGE(1) .AND. sval /= ''
2145	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2146	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2147	END FUNCTION getKeyByName_im11
2148	!==============================================================================================================================
2149	LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2150	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2151	REAL , INTENT(OUT) :: val
2152	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2153	REAL, OPTIONAL, INTENT(IN) :: def
2154	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2155	!------------------------------------------------------------------------------------------------------------------------------
2156	CHARACTER(LEN=maxlen) :: sval, s
2157	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
2158	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2159	IF(lerr) RETURN
2160	val = str2real(sval)
2161	lerr = val == -HUGE(1.) .AND. sval /= ''
2162	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2163	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2164	END FUNCTION getKeyByName_rm11
2165	!==============================================================================================================================
2166	LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2167	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2168	LOGICAL, INTENT(OUT) :: val
2169	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2170	LOGICAL, OPTIONAL, INTENT(IN) :: def
2171	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2172	!------------------------------------------------------------------------------------------------------------------------------
2173	CHARACTER(LEN=maxlen) :: sval, s
2174	INTEGER :: ival
2175	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
2176	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2177	IF(lerr) RETURN
2178	ival = str2bool(sval)
2179	lerr = ival == -1 .AND. sval /= ''
2180	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2181	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2182	IF(.NOT.lerr) val = ival == 1
2183	END FUNCTION getKeyByName_lm11
2184	!==============================================================================================================================
2185	!==============================================================================================================================
2186	LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2187	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2188	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2189	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2190	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2191	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2192	!------------------------------------------------------------------------------------------------------------------------------
2193	CHARACTER(LEN=maxlen) :: sval
2194	lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
2195	lerr = strParse(sval, ',', val)
2196	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2197	END FUNCTION getKeyByName_s1m1
2198	!==============================================================================================================================
2199	LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2200	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2201	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2202	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2203	INTEGER, OPTIONAL, INTENT(IN) :: def
2204	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2205	!------------------------------------------------------------------------------------------------------------------------------
2206	CHARACTER(LEN=maxlen) :: sval, s
2207	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2208	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
2209	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2210	IF(lerr) RETURN
2211	lerr = strParse(sval, ',', svals)
2212	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2213	val = str2int(svals)
2214	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
2215	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2216	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2217	END FUNCTION getKeyByName_i1m1
2218	!==============================================================================================================================
2219	LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2220	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2221	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2222	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2223	REAL, OPTIONAL, INTENT(IN) :: def
2224	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2225	!------------------------------------------------------------------------------------------------------------------------------
2226	CHARACTER(LEN=maxlen) :: sval, s
2227	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2228	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
2229	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2230	IF(lerr) RETURN
2231	lerr = strParse(sval, ',', svals)
2232	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2233	val = str2real(svals)
2234	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
2235	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2236	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2237	END FUNCTION getKeyByName_r1m1
2238	!==============================================================================================================================
2239	LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2240	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2241	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2242	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2243	LOGICAL, OPTIONAL, INTENT(IN) :: def
2244	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2245	!------------------------------------------------------------------------------------------------------------------------------
2246	CHARACTER(LEN=maxlen) :: sval, s
2247	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2248	INTEGER, ALLOCATABLE :: ivals(:)
2249	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
2250	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2251	IF(lerr) RETURN
2252	lerr = strParse(sval, ',', svals)
2253	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2254	ivals = str2bool(svals)
2255	lerr = ANY(ivals == -1) .AND. sval /= ''
2256	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2257	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2258	IF(.NOT.lerr) val = ivals == 1
2259	END FUNCTION getKeyByName_l1m1
2260	!==============================================================================================================================
2261	!==============================================================================================================================
2262	LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2263	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2264	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2265	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2266	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2267	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2268	!------------------------------------------------------------------------------------------------------------------------------
2269	CHARACTER(LEN=maxlen) :: sval
2270	lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
2271	lerr = strParse(sval, ',', val)
2272	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2273	END FUNCTION getKeyByName_smm1
2274	!==============================================================================================================================
2275	LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2276	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2277	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2278	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2279	INTEGER, OPTIONAL, INTENT(IN) :: def
2280	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2281	!------------------------------------------------------------------------------------------------------------------------------
2282	CHARACTER(LEN=maxlen) :: sval, s
2283	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2284	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
2285	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2286	IF(lerr) RETURN
2287	lerr = strParse(sval, ',', svals)
2288	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2289	val = str2int(svals)
2290	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
2291	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2292	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2293	END FUNCTION getKeyByName_imm1
2294	!==============================================================================================================================
2295	LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2296	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2297	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2298	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2299	REAL, OPTIONAL, INTENT(IN) :: def
2300	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2301	!------------------------------------------------------------------------------------------------------------------------------
2302	CHARACTER(LEN=maxlen) :: sval, s
2303	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2304	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
2305	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2306	IF(lerr) RETURN
2307	lerr = strParse(sval, ',', svals)
2308	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2309	val = str2real(svals)
2310	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
2311	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2312	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2313	END FUNCTION getKeyByName_rmm1
2314	!==============================================================================================================================
2315	LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2316	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2317	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2318	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2319	LOGICAL, OPTIONAL, INTENT(IN) :: def
2320	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2321	!------------------------------------------------------------------------------------------------------------------------------
2322	CHARACTER(LEN=maxlen) :: sval, s
2323	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2324	INTEGER, ALLOCATABLE :: ivals(:)
2325	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
2326	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2327	IF(lerr) RETURN
2328	lerr = strParse(sval, ',', svals)
2329	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
2330	ivals = str2bool(svals)
2331	lerr = ANY(ivals == -1) .AND. sval /= ''
2332	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2333	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2334	IF(.NOT.lerr) val = ivals == 1
2335	END FUNCTION getKeyByName_lmm1
2336	!==============================================================================================================================
2337	!==============================================================================================================================
2338	LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2339	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2340	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2341	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2342	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2343	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2344	lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
2345	END FUNCTION getKeyByName_s1mm
2346	!==============================================================================================================================
2347	LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2348	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2349	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2350	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2351	INTEGER, OPTIONAL, INTENT(IN) :: def
2352	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2353	lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
2354	END FUNCTION getKeyByName_i1mm
2355	!==============================================================================================================================
2356	LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2357	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2358	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2359	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2360	REAL, OPTIONAL, INTENT(IN) :: def
2361	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2362	lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
2363	END FUNCTION getKeyByName_r1mm
2364	!==============================================================================================================================
2365	LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2366	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2367	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2368	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2369	LOGICAL, OPTIONAL, INTENT(IN) :: def
2370	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2371	lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
2372	END FUNCTION getKeyByName_l1mm
2373	!==============================================================================================================================
2374	!==============================================================================================================================
2375	LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2376	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2377	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2378	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2379	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2380	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2381	!------------------------------------------------------------------------------------------------------------------------------
2382	CHARACTER(LEN=maxlen) :: s
2383	INTEGER :: iq, nq
2384	LOGICAL :: lD
2385	nq = SIZE(tname); ALLOCATE(val(nq))
2386	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
2387	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
2388	lerr = .TRUE.
2389	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
2390	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)) !--- "tracers"
2391	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
2392	END IF
2393	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
2394
2395	!--- DEFAULT VALUE
2396	val = [(def, iq = 1, SIZE(tname))]
2397	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
2398
2399	CONTAINS
2400
2401	FUNCTION fgetKey(ky) RESULT(val)
2402	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
2403	TYPE(keys_type), INTENT(IN) :: ky(:)
2404	LOGICAL, ALLOCATABLE :: ler(:)
2405	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname_all(:)
2406	lerr = SIZE(ky) == 0; IF(lerr) RETURN
2407	lerr = getKey('name', tname_all, ky); IF(lerr) RETURN
2408	ALLOCATE(ler(SIZE(tname)))
2409	val = [(fgetKeyIdx(strIdx(tname_all, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
2410	lerr = ANY(ler)
2411	END FUNCTION fgetKey
2412
2413	END FUNCTION getKeyByName_smmm
2414	!==============================================================================================================================
2415	LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2416	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2417	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2418	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2419	INTEGER, OPTIONAL, INTENT(IN) :: def
2420	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2421	!------------------------------------------------------------------------------------------------------------------------------
2422	CHARACTER(LEN=maxlen) :: s
2423	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2424	LOGICAL, ALLOCATABLE :: ll(:)
2425	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
2426	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2427	IF(lerr) RETURN
2428	val = str2int(svals)
2429	ll = val == -HUGE(1) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
2430	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2431	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2432	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
2433	END FUNCTION getKeyByName_immm
2434	!==============================================================================================================================
2435	LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2436	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2437	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2438	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2439	REAL, OPTIONAL, INTENT(IN) :: def
2440	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2441	!------------------------------------------------------------------------------------------------------------------------------
2442	CHARACTER(LEN=maxlen) :: s
2443	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2444	LOGICAL, ALLOCATABLE :: ll(:)
2445	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
2446	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2447	IF(lerr) RETURN
2448	val = str2real(svals)
2449	ll = val == -HUGE(1.) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
2450	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2451	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2452	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
2453	END FUNCTION getKeyByName_rmmm
2454	!==============================================================================================================================
2455	LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2456	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2457	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2458	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2459	LOGICAL, OPTIONAL, INTENT(IN) :: def
2460	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2461	!------------------------------------------------------------------------------------------------------------------------------
2462	CHARACTER(LEN=maxlen) :: s
2463	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2464	LOGICAL, ALLOCATABLE :: ll(:)
2465	INTEGER, ALLOCATABLE :: ivals(:)
2466	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
2467	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2468	IF(lerr) RETURN
2469	ivals = str2bool(svals)
2470	ll = ivals == -1 .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
2471	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
2472	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2473	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
2474	END FUNCTION getKeyByName_lmmm
2475	!==============================================================================================================================
2476
2477
2478	!==============================================================================================================================
2479	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
2480	!==============================================================================================================================
2481	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
2482	TYPE(keys_type), OPTIONAL, INTENT(IN) :: tracers_(:)
2483	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
2484	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
2485	!------------------------------------------------------------------------------------------------------------------------------
2486	TYPE(isot_type), ALLOCATABLE :: iso(:)
2487	INTEGER :: ix, nbIso
2488	IF(PRESENT( tracers_)) THEN; tracers = tracers_; ELSE; ALLOCATE( tracers(0)); END IF
2489	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
2490	IF(PRESENT(isotope_ )) THEN
2491	ix = strIdx(isotopes(:)%name, isotope_%name)
2492	IF(ix /= 0) THEN
2493	isotopes(ix) = isotope_
2494	ELSE
2495	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
2496	CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
2497	END IF
2498	END IF
2499	END SUBROUTINE setKeysDBase
2500	!==============================================================================================================================
2501	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
2502	TYPE(keys_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
2503	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
2504	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
2505	!------------------------------------------------------------------------------------------------------------------------------
2506	INTEGER :: ix
2507	IF(PRESENT( tracers_)) THEN; tracers_ = tracers; ELSE; ALLOCATE( tracers_(0)); END IF
2508	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
2509	IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%name, isotope%name); IF(ix /= 0) isotope_=isotopes(ix); END IF
2510	END SUBROUTINE getKeysDBase
2511	!==============================================================================================================================
2512
2513
2514	!==============================================================================================================================
2515	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
2516	!==============================================================================================================================
2517	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
2518	CHARACTER(LEN=*), INTENT(IN) :: s
2519	!------------------------------------------------------------------------------------------------------------------------------
2520	INTEGER :: ix, ip, ns
2521	out = s; ns = LEN_TRIM(s)
2522	IF(s == '' .OR. ns<=2) RETURN !--- Empty string or LEN(name)<=2: nothing to do
2523	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
2524	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
2525	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
2526	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
2527	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
2528	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
2529	END IF
2530	END FUNCTION delPhase
2531	!==============================================================================================================================
2532	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
2533	CHARACTER(LEN=*), INTENT(IN) :: s
2534	CHARACTER(LEN=1), INTENT(IN) :: pha
2535	!------------------------------------------------------------------------------------------------------------------------------
2536	INTEGER :: l, i
2537	out = s
2538	IF(s == '') RETURN !--- Empty string: nothing to do
2539	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
2540	l = LEN_TRIM(s)
2541	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
2542	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
2543	END FUNCTION addPhase_s1
2544	!==============================================================================================================================
2545	FUNCTION addPhase_sm(s,pha) RESULT(out)
2546	CHARACTER(LEN=*), INTENT(IN) :: s(:)
2547	CHARACTER(LEN=1), INTENT(IN) :: pha
2548	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
2549	!------------------------------------------------------------------------------------------------------------------------------
2550	INTEGER :: k
2551	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
2552	END FUNCTION addPhase_sm
2553	!==============================================================================================================================
2554	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
2555	CHARACTER(LEN=*), INTENT(IN) :: s
2556	INTEGER, INTENT(IN) :: ipha
2557	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2558	!------------------------------------------------------------------------------------------------------------------------------
2559	out = s
2560	IF(s == '') RETURN !--- Empty string: nothing to do
2561	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
2562	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
2563	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
2564	END FUNCTION addPhase_i1
2565	!==============================================================================================================================
2566	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
2567	CHARACTER(LEN=*), INTENT(IN) :: s(:)
2568	INTEGER, INTENT(IN) :: ipha
2569	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2570	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
2571	!------------------------------------------------------------------------------------------------------------------------------
2572	INTEGER :: k
2573	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
2574	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
2575	END FUNCTION addPhase_im
2576	!==============================================================================================================================
2577
2578
2579	!==============================================================================================================================
2580	!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
2581	!==============================================================================================================================
2582	LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
2583	CHARACTER(LEN=*), INTENT(IN) :: tname
2584	TYPE(keys_type), INTENT(IN) :: keys
2585	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
2586	TYPE(keys_type), ALLOCATABLE :: tr(:)
2587	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
2588	INTEGER :: nt, ix
2589	IF(ALLOCATED(tracs)) THEN
2590	lerr = getKey('name', tnames, ky=tracs(:)); IF(lerr) RETURN
2591	nt = SIZE(tracs)
2592	ix = strIdx(tnames, tname)
2593	CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
2594	CALL msg('Appending with tracer "' //TRIM(tname)//'"', modname, ix == 0)
2595	IF(ix == 0) THEN
2596	ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
2597	END IF
2598	ELSE
2599	CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
2600	ix = 1; ALLOCATE(tracs(1))
2601	END IF
2602	CALL addKey('name', tname, tracs(ix))
2603	tracs(ix) = keys
2604
2605	END FUNCTION addTracer_1
2606	!==============================================================================================================================
2607	LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
2608	CHARACTER(LEN=*), INTENT(IN) :: tname
2609	TYPE(keys_type), INTENT(IN) :: keys
2610	lerr = addTracer_1(tname, keys, tracers)
2611	END FUNCTION addTracer_1def
2612	!==============================================================================================================================
2613
2614
2615	!==============================================================================================================================
2616	LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
2617	CHARACTER(LEN=*), INTENT(IN) :: tname
2618	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
2619	TYPE(keys_type), ALLOCATABLE :: tr(:)
2620	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
2621	INTEGER :: nt, ix
2622	lerr = .NOT.ALLOCATED(tracs)
2623	IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
2624	nt = SIZE(tracs)
2625	lerr = getKey('name', tnames, ky=tracs(:)); IF(lerr) RETURN
2626	ix = strIdx(tnames, tname)
2627	CALL msg('Removing tracer "' //TRIM(tname)//'"', modname, ix /= 0)
2628	CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
2629	IF(ix /= 0) THEN
2630	ALLOCATE(tr(nt-1)); tr(1:ix-1) = tracs(1:ix-1); tr(ix:nt-1) = tracs(ix+1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
2631	END IF
2632	END FUNCTION delTracer_1
2633	!==============================================================================================================================
2634	LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
2635	CHARACTER(LEN=*), INTENT(IN) :: tname
2636	lerr = delTracer(tname, tracers)
2637	END FUNCTION delTracer_1def
2638	!==============================================================================================================================
2639
2640
2641	!==============================================================================================================================
2642	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
2643	!==============================================================================================================================
2644	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
2645	CHARACTER(LEN=*), INTENT(IN) :: tname
2646	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2647	!------------------------------------------------------------------------------------------------------------------------------
2648	CHARACTER(LEN=maxlen) :: phase
2649	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
2650	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
2651	END FUNCTION getiPhase
2652	!==============================================================================================================================
2653	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
2654	CHARACTER(LEN=*), INTENT(IN) :: tname
2655	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2656	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2657	!------------------------------------------------------------------------------------------------------------------------------
2658	INTEGER :: ip
2659	phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
2660	IF( PRESENT(phases)) ip = INDEX( phases, phase)
2661	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
2662	IF(ip == 0) phase = 'g'
2663	IF(PRESENT(iPhase)) iPhase = ip
2664	END FUNCTION getPhase
2665	!==============================================================================================================================
2666
2667
2668	!==============================================================================================================================
2669	!======== CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION & VICE VERSA ; OTHER NAMES ARE LEFT UNTOUCHED =========
2670	!===== OLD NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ==
2671	!==== NEW NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var>='H2O' or from "newH2OIso") ==
2672	!==============================================================================================================================
2673	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
2674	CHARACTER(LEN=*), INTENT(IN) :: oldName
2675	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2676	!------------------------------------------------------------------------------------------------------------------------------
2677	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
2678	INTEGER :: ix, ip, nt
2679	LOGICAL :: lerr
2680	newName = oldName
2681	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
2682	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
2683	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
2684	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
2685	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
2686	IF(nt == 1) THEN
2687	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
2688	ELSE
2689	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
2690	IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name
2691	IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name
2692	IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER
2693	END IF
2694	END FUNCTION old2newH2O_1
2695	!==============================================================================================================================
2696	FUNCTION old2newH2O_m(oldName) RESULT(newName)
2697	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
2698	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
2699	!------------------------------------------------------------------------------------------------------------------------------
2700	INTEGER :: i
2701	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
2702	END FUNCTION old2newH2O_m
2703	!==============================================================================================================================
2704	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
2705	CHARACTER(LEN=*), INTENT(IN) :: newName
2706	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2707	!------------------------------------------------------------------------------------------------------------------------------
2708	INTEGER :: ix, ip
2709	CHARACTER(LEN=maxlen) :: var
2710	oldName = newName
2711	ip = getiPhase(newName) !--- Phase index
2712	IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous)
2713	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag
2714	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
2715	IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished
2716	oldName = 'H2O'
2717	IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip) !--- Add phase if needed
2718	IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix) !--- H2O isotope name
2719	IF(newName /= addPhase(var, ip)) &
2720	oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.) !--- Add the tag suffix
2721	IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix
2722	END FUNCTION new2oldH2O_1
2723	!==============================================================================================================================
2724	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
2725	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
2726	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
2727	!------------------------------------------------------------------------------------------------------------------------------
2728	INTEGER :: i
2729	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
2730	END FUNCTION new2oldH2O_m
2731	!==============================================================================================================================
2732
2733	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format