Context Navigation

readTracFiles_mod.f90 @ 5801

Last change on this file since 5801 was 5801, checked in by Sebastien Nguyen, 3 months ago
field iqParent from tracers was left blankwhen it needs to take value iqParent(iq). This bug appeared in rev 5005 where key parent was used instead of field iqParent. It corrects initialization problems in dynetat0_loc and infotarc_phy.
File size: 176.0 KB

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

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

Download in other formats:

Original Format