Context Navigation

readTracFiles_mod.f90 @ 5756

Last change on this file since 5756 was 5756, checked in by dcugnet, 4 days ago
Add "isoFamilies", the list of defined isotopes families (==H2O? for now).
File size: 175.9 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	DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
1077	CALL addKey('iqParent', parent(iq), tr(iq)%keys)
1078	CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
1079	END DO
1080
1081	!=== nqChildren, iqDescen, nqDescen
1082	nGen = MAXVAL(iGen, MASK=.TRUE.)
1083	DO iq = 1, nq
1084	ix = [iq]; ALLOCATE(iqDescen(0))
1085	DO ig = iGen(iq)+1, nGen
1086	iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
1087	IF(ig /= iGen(iq)+1) CYCLE
1088	CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
1089	tr(iq)%nqChildren = SIZE(iqDescen)
1090	END DO
1091	CALL addKey('iqDescen', strStack(num2str(iqDescen)), tr(iq)%keys)
1092	CALL addKey('nqDescen', SIZE(iqDescen), tr(iq)%keys)
1093	tr(iq)%iqDescen = iqDescen
1094	tr(iq)%nqDescen = SIZE(iqDescen)
1095	DEALLOCATE(iqDescen)
1096	END DO
1097	END FUNCTION indexUpdate
1098	!==============================================================================================================================
1099
1100
1101	!==============================================================================================================================
1102	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
1103	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
1104	!=== * For each isotopes family, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
1105	!=== NOTES: ====
1106	!=== * Most of the "isot" components have been defined in the calling routine (processIsotopes): ====
1107	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
1108	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
1109	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
1110	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
1111	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
1112	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
1113	!==============================================================================================================================
1114	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
1115	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
1116	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!)
1117	LOGICAL :: lFound
1118	INTEGER :: is, iis, it, idb, ndb, nb0
1119	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
1120	CHARACTER(LEN=maxlen) :: modname
1121	TYPE(trac_type), POINTER :: tt(:), t
1122	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
1123	modname = 'readIsotopesFile'
1124
1125	!--- THE INPUT FILE MUST BE PRESENT
1126	INQUIRE(FILE=TRIM(fnam), EXIST=lFound); lerr = .NOT.lFound
1127	CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr); IF(lerr) RETURN
1128
1129	!--- READ THE FILE SECTIONS, ONE EACH ISOTOPES FAMILY
1130	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
1131	lerr = readSections(fnam,strStack(isot(:)%parent,'\|')); IF(lerr) RETURN !--- Read sections, one each isotopes family
1132	ndb = SIZE(dBase, DIM=1) !--- Current database size
1133	DO idb = nb0, ndb
1134	iis = idb-nb0+1
1135
1136	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
1137	! CALL addKeysFromDef(dBase(idb)%trac, 'params')
1138
1139	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
1140	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
1141
1142	tt => dBase(idb)%trac
1143
1144	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
1145	DO it = 1, SIZE(dBase(idb)%trac)
1146	t => dBase(idb)%trac(it)
1147	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
1148	IF(is == 0) CYCLE
1149	lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN !--- Reduce expressions ; detect non-numerical elements
1150	isot(iis)%keys(is)%key = t%keys%key
1151	isot(iis)%keys(is)%val = vals
1152	END DO
1153
1154	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
1155	lerr = checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
1156	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
1157	IF(lerr) RETURN
1158	END DO
1159
1160	!--- CLEAN THE DATABASE ENTRIES
1161	IF(nb0 == 1) THEN
1162	DEALLOCATE(dBase); ALLOCATE(dBase(0))
1163	ELSE
1164	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
1165	END IF
1166
1167	lerr = dispIsotopes()
1168
1169	CONTAINS
1170
1171	!------------------------------------------------------------------------------------------------------------------------------
1172	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
1173	INTEGER :: ik, nk, ip, it, nt
1174	CHARACTER(LEN=maxlen) :: prf
1175	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
1176	CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
1177	DO ip = 1, SIZE(isot) !--- Loop on isotopes families
1178	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
1179	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
1180	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
1181	ALLOCATE(ttl(nk+2), val(nt,nk+1))
1182	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
1183	val(:,1) = isot(ip)%keys(:)%name !--- Values table 1st column: isotopes names
1184	DO ik = 1, nk
1185	DO it = 1, nt
1186	val(it,ik+1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
1187	END DO
1188	END DO
1189	lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
1190	CALL msg('Problem with the table content', modname, lerr); IF(lerr) RETURN
1191	DEALLOCATE(ttl, val)
1192	END DO
1193	END FUNCTION dispIsotopes
1194	!------------------------------------------------------------------------------------------------------------------------------
1195
1196	END FUNCTION readIsotopesFile
1197	!==============================================================================================================================
1198
1199
1200	!==============================================================================================================================
1201	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
1202	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
1203	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
1204	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
1205	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
1206	!==============================================================================================================================
1207	LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
1208	CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN) :: iNames(:)
1209	CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
1210	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
1211	CHARACTER(LEN=maxlen) :: iName, modname
1212	CHARACTER(LEN=1) :: ph !--- Phase
1213	INTEGER, ALLOCATABLE :: iGen(:)
1214	INTEGER :: ic, ip, iq, it, iz
1215	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
1216	TYPE(trac_type), POINTER :: t(:), t1
1217	TYPE(isot_type), POINTER :: i
1218
1219	lerr = .FALSE.
1220	modname = 'readIsotopesFile'
1221
1222	t => tracers
1223
1224	lerr = getKey('name', tname, t%keys); IF(lerr) RETURN !--- Names
1225	lerr = getKey('parent', parent, t%keys); IF(lerr) RETURN !--- Parents
1226	lerr = getKey('type', dType, t%keys); IF(lerr) RETURN !--- Tracer type
1227	lerr = getKey('phase', phase, t%keys); IF(lerr) RETURN !--- Phase
1228	lerr = getKey('gen0Name', gen0N, t%keys); IF(lerr) RETURN !--- 1st generation ancestor name
1229	lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN !--- Generation number
1230
1231	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES FAMILIES
1232	p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
1233	CALL strReduce(p, nbIso)
1234
1235	!--- CHECK WHETHER NEEDED ISOTOPES FAMILIES "iNames" ARE AVAILABLE OR NOT
1236	IF(PRESENT(iNames)) THEN
1237	DO it = 1, SIZE(iNames)
1238	lerr = ALL(p /= iNames(it))
1239	CALL msg('No isotopes family "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
1240	END DO
1241	p = iNames; nbIso = SIZE(p)
1242	END IF
1243	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
1244	ALLOCATE(isotopes(nbIso), isoFamilies(nbIso))
1245
1246	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
1247
1248	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
1249	isotopes(:)%parent = p
1250	DO ic = 1, SIZE(p) !--- Loop on isotopes families
1251	i => isotopes(ic)
1252	iname = i%parent !--- Current isotopes family name (parent tracer name)
1253
1254	!=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
1255	ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
1256	str = PACK(delPhase(tname), MASK = ll) !--- Effectively found isotopes of "iname"
1257	i%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
1258	ALLOCATE(i%keys(i%niso))
1259	FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
1260
1261	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
1262	ll = dType=='tag' .AND. delPhase(gen0N) == iname .AND. iGen == 2
1263	i%zone = PACK(strTail(tname,'_',.TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
1264	CALL strReduce(i%zone)
1265	i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname"
1266
1267	!=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
1268	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
1269	str = PACK(delPhase(tname), MASK=ll)
1270	CALL strReduce(str)
1271	i%ntiso = i%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntiso]
1272	ALLOCATE(i%trac(i%ntiso))
1273	FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
1274	FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
1275
1276	!=== Phases for tracer "iname"
1277	i%phase = ''
1278	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
1279	i%nphas = LEN_TRIM(i%phase) !--- Equal to "nqo" for water
1280
1281	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
1282	DO iq = 1, SIZE(t)
1283	t1 => tracers(iq)
1284	IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname"
1285	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
1286	t1%iso_iName = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope idx in effective isotopes list
1287	t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone idx in effective zones list
1288	t1%iso_iPhase = INDEX(i%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
1289	IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers
1290	END DO
1291
1292	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
1293	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1294	i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], &
1295	[i%ntiso, i%nphas] )
1296	!=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
1297	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1298	i%iqWIsoPha = RESHAPE( [( [strIdx(t%name, addPhase('H2O',i%phase(ip:ip))), i%iqIsoPha(:,ip)], ip=1,i%nphas)], &
1299	[1+i%ntiso, i%nphas] )
1300	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
1301	i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
1302	[i%nzone, i%niso] )
1303	END DO
1304
1305	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE
1306	! lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
1307
1308	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
1309	CALL getin_p('ok_iso_verif', isoCheck, .TRUE.)
1310
1311	!=== CHECK CONSISTENCY
1312	lerr = testIsotopes(); IF(lerr) RETURN
1313
1314	!=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
1315	IF(.NOT.isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
1316
1317	!=== COLLECT THE NAMES OF THE ISOTOPES FAMILIES
1318	isoFamilies = isotopes(:)%parent
1319
1320	CONTAINS
1321
1322	!------------------------------------------------------------------------------------------------------------------------------
1323	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
1324	!------------------------------------------------------------------------------------------------------------------------------
1325	INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
1326	TYPE(isot_type), POINTER :: i
1327	DO ix = 1, nbIso
1328	i => isotopes(ix)
1329	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
1330	DO it = 1, i%ntiso; npha = i%nphas
1331	np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, npha)])
1332	lerr = np /= npha
1333	CALL msg(TRIM(num2str(np))//' phases instead of '//TRIM(num2str(npha))//' for '//TRIM(i%trac(it)), modname, lerr)
1334	IF(lerr) RETURN
1335	END DO
1336	DO it = 1, i%niso; nzon = i%nzone
1337	nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, nzon)])
1338	lerr = nz /= nzon
1339	CALL msg(TRIM(num2str(nz))//' tagging zones instead of '//TRIM(num2str(nzon))//' for '//TRIM(i%trac(it)), modname, lerr)
1340	IF(lerr) RETURN
1341	END DO
1342	END DO
1343	END FUNCTION testIsotopes
1344	!------------------------------------------------------------------------------------------------------------------------------
1345
1346	END FUNCTION processIsotopes
1347	!==============================================================================================================================
1348
1349
1350	!==============================================================================================================================
1351	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
1352	! Single generic "isoSelect" routine, using the predefined index of the family (fast version) or its name (first call).
1353	!==============================================================================================================================
1354	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
1355	IMPLICIT NONE
1356	CHARACTER(LEN=*), INTENT(IN) :: iName
1357	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1358	INTEGER :: iIso
1359	LOGICAL :: lV
1360	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
1361	iIso = strIdx(isotopes(:)%parent, iName)
1362	lerr = iIso == 0
1363	IF(lerr) THEN
1364	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
1365	CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
1366	RETURN
1367	END IF
1368	lerr = isoSelectByIndex(iIso, lV)
1369	END FUNCTION isoSelectByName
1370	!==============================================================================================================================
1371	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
1372	IMPLICIT NONE
1373	INTEGER, INTENT(IN) :: iIso
1374	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1375	LOGICAL :: lV
1376	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
1377	lerr = .FALSE.
1378	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
1379	lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
1380	CALL msg('Inconsistent isotopes family index '//TRIM(num2str(iIso))//': should be > 0 and <= '&
1381	//TRIM(num2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
1382	IF(lerr) RETURN
1383	ixIso = iIso !--- Update currently selected family index
1384	isotope => isotopes(ixIso) !--- Select corresponding component
1385	isoKeys => isotope%keys; niso = isotope%niso
1386	isoName => isotope%trac; ntiso = isotope%ntiso
1387	isoZone => isotope%zone; nzone = isotope%nzone
1388	isoPhas => isotope%phase; nphas = isotope%nphas
1389	itZonIso => isotope%itZonIso; isoCheck = isotope%check
1390	iqIsoPha => isotope%iqIsoPha
1391	iqWIsoPha => isotope%iqWIsoPha
1392	END FUNCTION isoSelectByIndex
1393	!==============================================================================================================================
1394
1395
1396	!==============================================================================================================================
1397	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
1398	!==============================================================================================================================
1399	SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
1400	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1401	TYPE(keys_type), INTENT(INOUT) :: ky
1402	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1403	!------------------------------------------------------------------------------------------------------------------------------
1404	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1405	INTEGER :: iky, nky
1406	LOGICAL :: lo
1407	lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
1408	IF(.NOT.ALLOCATED(ky%key)) THEN
1409	ALLOCATE(ky%key(1)); ky%key(1)=key
1410	ALLOCATE(ky%val(1)); ky%val(1)=sval
1411	RETURN
1412	END IF
1413	iky = strIdx(ky%key,key)
1414	IF(iky == 0) THEN
1415	nky = SIZE(ky%key)
1416	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
1417	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
1418	ELSE IF(lo) THEN
1419	ky%key(iky) = key; ky%val(iky) = sval
1420	END IF
1421	END SUBROUTINE addKey_s11
1422	!==============================================================================================================================
1423	SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
1424	CHARACTER(LEN=*), INTENT(IN) :: key
1425	INTEGER, INTENT(IN) :: ival
1426	TYPE(keys_type), INTENT(INOUT) :: ky
1427	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1428	!------------------------------------------------------------------------------------------------------------------------------
1429	CALL addKey_s11(key, num2str(ival), ky, lOverWrite)
1430	END SUBROUTINE addKey_i11
1431	!==============================================================================================================================
1432	SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
1433	CHARACTER(LEN=*), INTENT(IN) :: key
1434	REAL, INTENT(IN) :: rval
1435	TYPE(keys_type), INTENT(INOUT) :: ky
1436	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1437	!------------------------------------------------------------------------------------------------------------------------------
1438	CALL addKey_s11(key, num2str(rval), ky, lOverWrite)
1439	END SUBROUTINE addKey_r11
1440	!==============================================================================================================================
1441	SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
1442	CHARACTER(LEN=*), INTENT(IN) :: key
1443	LOGICAL, INTENT(IN) :: lval
1444	TYPE(keys_type), INTENT(INOUT) :: ky
1445	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1446	!------------------------------------------------------------------------------------------------------------------------------
1447	CALL addKey_s11(key, num2str(lval), ky, lOverWrite)
1448	END SUBROUTINE addKey_l11
1449	!==============================================================================================================================
1450	!==============================================================================================================================
1451	SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
1452	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1453	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1454	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1455	!------------------------------------------------------------------------------------------------------------------------------
1456	INTEGER :: itr
1457	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
1458	END SUBROUTINE addKey_s1m
1459	!==============================================================================================================================
1460	SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
1461	CHARACTER(LEN=*), INTENT(IN) :: key
1462	INTEGER, INTENT(IN) :: ival
1463	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1464	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1465	!------------------------------------------------------------------------------------------------------------------------------
1466	INTEGER :: itr
1467	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(ival), ky(itr), lOverWrite); END DO
1468	END SUBROUTINE addKey_i1m
1469	!==============================================================================================================================
1470	SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
1471	CHARACTER(LEN=*), INTENT(IN) :: key
1472	REAL, INTENT(IN) :: rval
1473	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1474	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1475	!------------------------------------------------------------------------------------------------------------------------------
1476	INTEGER :: itr
1477	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(rval), ky(itr), lOverWrite); END DO
1478	END SUBROUTINE addKey_r1m
1479	!==============================================================================================================================
1480	SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
1481	CHARACTER(LEN=*), INTENT(IN) :: key
1482	LOGICAL, INTENT(IN) :: lval
1483	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1484	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1485	!------------------------------------------------------------------------------------------------------------------------------
1486	INTEGER :: itr
1487	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(lval), ky(itr), lOverWrite); END DO
1488	END SUBROUTINE addKey_l1m
1489	!==============================================================================================================================
1490	!==============================================================================================================================
1491	SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
1492	CHARACTER(LEN=*), INTENT(IN) :: key, sval(:)
1493	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1494	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1495	!------------------------------------------------------------------------------------------------------------------------------
1496	INTEGER :: itr
1497	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
1498	END SUBROUTINE addKey_smm
1499	!==============================================================================================================================
1500	SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
1501	CHARACTER(LEN=*), INTENT(IN) :: key
1502	INTEGER, INTENT(IN) :: ival(:)
1503	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1504	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1505	!------------------------------------------------------------------------------------------------------------------------------
1506	INTEGER :: itr
1507	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(ival(itr)), ky(itr), lOverWrite); END DO
1508	END SUBROUTINE addKey_imm
1509	!==============================================================================================================================
1510	SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
1511	CHARACTER(LEN=*), INTENT(IN) :: key
1512	REAL, INTENT(IN) :: rval(:)
1513	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1514	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1515	!------------------------------------------------------------------------------------------------------------------------------
1516	INTEGER :: itr
1517	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(rval(itr)), ky(itr), lOverWrite); END DO
1518	END SUBROUTINE addKey_rmm
1519	!==============================================================================================================================
1520	SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
1521	CHARACTER(LEN=*), INTENT(IN) :: key
1522	LOGICAL, INTENT(IN) :: lval(:)
1523	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1524	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1525	!------------------------------------------------------------------------------------------------------------------------------
1526	INTEGER :: itr
1527	DO itr = 1, SIZE(ky); CALL addKey_s11(key, num2str(lval(itr)), ky(itr), lOverWrite); END DO
1528	END SUBROUTINE addKey_lmm
1529	!==============================================================================================================================
1530
1531
1532	!==============================================================================================================================
1533	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
1534	!==============================================================================================================================
1535	!SUBROUTINE addKeysFromDef(t, tr0)
1536	! TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
1537	! CHARACTER(LEN=*), INTENT(IN) :: tr0
1538	!------------------------------------------------------------------------------------------------------------------------------
1539	! CHARACTER(LEN=maxlen) :: val
1540	! INTEGER :: ik, jd
1541	! jd = strIdx(t%name, tr0)
1542	! IF(jd == 0) RETURN
1543	! DO ik = 1, SIZE(t(jd)%keys%key)
1544	! CALL getin_p(t(jd)%keys%key(ik), val, 'none')
1545	! IF(val /= 'none') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
1546	! END DO
1547	!END SUBROUTINE addKeysFromDef
1548	!==============================================================================================================================
1549
1550
1551	!==============================================================================================================================
1552	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
1553	!==============================================================================================================================
1554	SUBROUTINE delKey_1(itr, keyn, ky)
1555	INTEGER, INTENT(IN) :: itr
1556	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1557	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1558	!------------------------------------------------------------------------------------------------------------------------------
1559	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1560	LOGICAL, ALLOCATABLE :: ll(:)
1561	INTEGER :: iky
1562	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
1563	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
1564	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
1565	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
1566	END SUBROUTINE delKey_1
1567	!==============================================================================================================================
1568	SUBROUTINE delKey(keyn, ky)
1569	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1570	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1571	!------------------------------------------------------------------------------------------------------------------------------
1572	INTEGER :: iky
1573	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
1574	END SUBROUTINE delKey
1575	!==============================================================================================================================
1576
1577
1578	!==============================================================================================================================
1579	!=== INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT ===
1580	!=== IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER ===
1581	!==============================================================================================================================
1582	CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
1583	INTEGER, INTENT(IN) :: itr
1584	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1585	TYPE(keys_type), INTENT(IN) :: ky(:)
1586	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1587	!------------------------------------------------------------------------------------------------------------------------------
1588	INTEGER :: ik
1589	LOGICAL :: ler
1590	ler = .TRUE.
1591	DO ik = 1, SIZE(keyn)
1592	CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
1593	END DO
1594	IF(PRESENT(lerr)) lerr = ler
1595
1596	CONTAINS
1597
1598	SUBROUTINE getKeyIdx(keyn)
1599	CHARACTER(LEN=*), INTENT(IN) :: keyn
1600	!------------------------------------------------------------------------------------------------------------------------------
1601	INTEGER :: iky
1602	iky = 0; val = ''
1603	ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
1604	iky = strIdx(ky(itr)%key(:), keyn)
1605	ler = iky == 0; IF(ler) RETURN
1606	val = ky(itr)%val(iky)
1607	END SUBROUTINE getKeyIdx
1608
1609	END FUNCTION fgetKeyIdx
1610	!==============================================================================================================================
1611
1612
1613	!==============================================================================================================================
1614	!=== GET KEYS VALUES FROM TRACERS INDICES ===
1615	!==============================================================================================================================
1616	!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN: ===
1617	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
1618	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
1619	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
1620	!=== * A SCALAR ===
1621	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
1622	!=== ===
1623	!=== SYNTAX: lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)] [, def][, lDisp]) ===
1624	!==============================================================================================================================
1625	!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)" ===
1626	!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)" ===
1627	!=== SYNTAX lerr = getKeyByIndex_{sirl}{1m}mm (keyn[(:)], val (:) [, ky(:)][, nam(:)][, def][, lDisp]) ===
1628	!==============================================================================================================================
1629	LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1630	CHARACTER(LEN=*), INTENT(IN) :: keyn
1631	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1632	INTEGER, INTENT(IN) :: itr
1633	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1634	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
1635	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1636	lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
1637	END FUNCTION getKeyByIndex_s111
1638	!==============================================================================================================================
1639	LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1640	CHARACTER(LEN=*), INTENT(IN) :: keyn
1641	INTEGER, INTENT(OUT) :: val
1642	INTEGER, INTENT(IN) :: itr
1643	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1644	INTEGER, OPTIONAL, INTENT(IN) :: def
1645	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1646	lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
1647	END FUNCTION getKeyByIndex_i111
1648	!==============================================================================================================================
1649	LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1650	CHARACTER(LEN=*), INTENT(IN) :: keyn
1651	REAL , INTENT(OUT) :: val
1652	INTEGER, INTENT(IN) :: itr
1653	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1654	REAL, OPTIONAL, INTENT(IN) :: def
1655	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1656	lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
1657	END FUNCTION getKeyByIndex_r111
1658	!==============================================================================================================================
1659	LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1660	CHARACTER(LEN=*), INTENT(IN) :: keyn
1661	LOGICAL, INTENT(OUT) :: val
1662	INTEGER, INTENT(IN) :: itr
1663	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1664	LOGICAL, OPTIONAL, INTENT(IN) :: def
1665	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1666	lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
1667	END FUNCTION getKeyByIndex_l111
1668	!==============================================================================================================================
1669	!==============================================================================================================================
1670	LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1671	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1672	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1673	INTEGER, INTENT(IN) :: itr
1674	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1675	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
1676	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1677	!------------------------------------------------------------------------------------------------------------------------------
1678	CHARACTER(LEN=maxlen) :: s
1679	LOGICAL :: lD
1680	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
1681	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(num2str(itr))
1682	lerr = .TRUE.
1683	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
1684	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys) !--- "tracers"
1685	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
1686	IF(lerr .AND. PRESENT(def)) THEN
1687	val = def; lerr = .NOT.PRESENT(def)
1688	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
1689	END IF
1690	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
1691
1692	CONTAINS
1693
1694	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
1695	TYPE(keys_type), INTENT(IN) :: ky(:)
1696	lerr = SIZE(ky) == 0; IF(lerr) RETURN
1697	val = fgetKeyIdx(itr, keyn(:), ky, lerr)
1698	END FUNCTION fgetKey
1699
1700	END FUNCTION getKeyByIndex_sm11
1701	!==============================================================================================================================
1702	LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1703	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1704	INTEGER, INTENT(OUT) :: val
1705	INTEGER, INTENT(IN) :: itr
1706	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1707	INTEGER, OPTIONAL, INTENT(IN) :: def
1708	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1709	!------------------------------------------------------------------------------------------------------------------------------
1710	CHARACTER(LEN=maxlen) :: sval, s
1711	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1712	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1713	IF(lerr) RETURN
1714	val = str2int(sval)
1715	lerr = val == -HUGE(1)
1716	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1717	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1718	END FUNCTION getKeyByIndex_im11
1719	!==============================================================================================================================
1720	LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1721	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1722	REAL , INTENT(OUT) :: val
1723	INTEGER, INTENT(IN) :: itr
1724	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1725	REAL, OPTIONAL, INTENT(IN) :: def
1726	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1727	!------------------------------------------------------------------------------------------------------------------------------
1728	CHARACTER(LEN=maxlen) :: sval, s
1729	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1730	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1731	IF(lerr) RETURN
1732	val = str2real(sval)
1733	lerr = val == -HUGE(1.)
1734	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1735	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1736	END FUNCTION getKeyByIndex_rm11
1737	!==============================================================================================================================
1738	LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1739	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1740	LOGICAL, INTENT(OUT) :: val
1741	INTEGER, INTENT(IN) :: itr
1742	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1743	LOGICAL, OPTIONAL, INTENT(IN) :: def
1744	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1745	!------------------------------------------------------------------------------------------------------------------------------
1746	CHARACTER(LEN=maxlen) :: sval, s
1747	INTEGER :: ival
1748	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1749	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1750	IF(lerr) RETURN
1751	ival = str2bool(sval)
1752	lerr = ival == -1
1753	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1754	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1755	IF(.NOT.lerr) val = ival == 1
1756	END FUNCTION getKeyByIndex_lm11
1757	!==============================================================================================================================
1758	!==============================================================================================================================
1759	LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1760	CHARACTER(LEN=*), INTENT(IN) :: keyn
1761	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1762	INTEGER, INTENT(IN) :: itr
1763	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1764	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1765	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1766	!------------------------------------------------------------------------------------------------------------------------------
1767	CHARACTER(LEN=maxlen) :: sval
1768	lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
1769	lerr = strParse(sval, ',', val)
1770	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1771	END FUNCTION getKeyByIndex_s1m1
1772	!==============================================================================================================================
1773	LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1774	CHARACTER(LEN=*), INTENT(IN) :: keyn
1775	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1776	INTEGER, INTENT(IN) :: itr
1777	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1778	INTEGER, OPTIONAL, INTENT(IN) :: def
1779	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1780	!------------------------------------------------------------------------------------------------------------------------------
1781	CHARACTER(LEN=maxlen) :: sval, s
1782	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1783	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, num2str(def), lDisp)
1784	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1785	IF(lerr) RETURN
1786	lerr = strParse(sval, ',', svals)
1787	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1788	val = str2int(svals)
1789	lerr = ANY(val == -HUGE(1))
1790	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1791	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1792	END FUNCTION getKeyByIndex_i1m1
1793	!==============================================================================================================================
1794	LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1795	CHARACTER(LEN=*), INTENT(IN) :: keyn
1796	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1797	INTEGER, INTENT(IN) :: itr
1798	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1799	REAL, OPTIONAL, INTENT(IN) :: def
1800	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1801	!------------------------------------------------------------------------------------------------------------------------------
1802	CHARACTER(LEN=maxlen) :: sval, s
1803	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1804	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, num2str(def), lDisp)
1805	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1806	lerr = strParse(sval, ',', svals)
1807	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1808	val = str2real(svals)
1809	lerr = ANY(val == -HUGE(1.))
1810	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1811	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1812	END FUNCTION getKeyByIndex_r1m1
1813	!==============================================================================================================================
1814	LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1815	CHARACTER(LEN=*), INTENT(IN) :: keyn
1816	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1817	INTEGER, INTENT(IN) :: itr
1818	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1819	LOGICAL, OPTIONAL, INTENT(IN) :: def
1820	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1821	!------------------------------------------------------------------------------------------------------------------------------
1822	CHARACTER(LEN=maxlen) :: sval, s
1823	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1824	INTEGER, ALLOCATABLE :: ivals(:)
1825	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, num2str(def), lDisp)
1826	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
1827	lerr = strParse(sval, ',', svals)
1828	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1829	ivals = str2bool(svals)
1830	lerr = ANY(ivals == -1)
1831	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1832	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1833	IF(.NOT.lerr) val = ivals == 1
1834	END FUNCTION getKeyByIndex_l1m1
1835	!==============================================================================================================================
1836	!==============================================================================================================================
1837	LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1838	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1839	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1840	INTEGER, INTENT(IN) :: itr
1841	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1842	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1843	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1844	!------------------------------------------------------------------------------------------------------------------------------
1845	CHARACTER(LEN=maxlen) :: sval
1846	lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
1847	lerr = strParse(sval, ',', val)
1848	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1849	END FUNCTION getKeyByIndex_smm1
1850	!==============================================================================================================================
1851	LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1852	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1853	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1854	INTEGER, INTENT(IN) :: itr
1855	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1856	INTEGER, OPTIONAL, INTENT(IN) :: def
1857	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1858	!------------------------------------------------------------------------------------------------------------------------------
1859	CHARACTER(LEN=maxlen) :: sval, s
1860	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1861	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1862	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1863	IF(lerr) RETURN
1864	lerr = strParse(sval, ',', svals)
1865	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1866	val = str2int(svals)
1867	lerr = ANY(val == -HUGE(1))
1868	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1869	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
1870	END FUNCTION getKeyByIndex_imm1
1871	!==============================================================================================================================
1872	LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1873	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1874	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1875	INTEGER, INTENT(IN) :: itr
1876	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1877	REAL, OPTIONAL, INTENT(IN) :: def
1878	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1879	!------------------------------------------------------------------------------------------------------------------------------
1880	CHARACTER(LEN=maxlen) :: sval, s
1881	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1882	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1883	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1884	IF(lerr) RETURN
1885	lerr = strParse(sval, ',', svals)
1886	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1887	val = str2real(svals)
1888	lerr = ANY(val == -HUGE(1.))
1889	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1890	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
1891	END FUNCTION getKeyByIndex_rmm1
1892	!==============================================================================================================================
1893	LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
1894	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1895	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1896	INTEGER, INTENT(IN) :: itr
1897	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1898	LOGICAL, OPTIONAL, INTENT(IN) :: def
1899	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1900	!------------------------------------------------------------------------------------------------------------------------------
1901	CHARACTER(LEN=maxlen) :: sval, s
1902	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
1903	INTEGER, ALLOCATABLE :: ivals(:)
1904	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, num2str(def), lDisp)
1905	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
1906	IF(lerr) RETURN
1907	lerr = strParse(sval, ',', svals)
1908	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
1909	ivals = str2bool(svals)
1910	lerr = ANY(ivals == -1)
1911	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(num2str(itr))//' is not'
1912	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
1913	IF(.NOT.lerr) val = ivals == 1
1914	END FUNCTION getKeyByIndex_lmm1
1915	!==============================================================================================================================
1916	!==============================================================================================================================
1917	LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
1918	CHARACTER(LEN=*), INTENT(IN) :: keyn
1919	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1920	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1921	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1922	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1923	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1924	lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
1925	END FUNCTION getKeyByIndex_s1mm
1926	!==============================================================================================================================
1927	LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
1928	CHARACTER(LEN=*), INTENT(IN) :: keyn
1929	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1930	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1931	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1932	INTEGER, OPTIONAL, INTENT(IN) :: def
1933	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1934	lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
1935	END FUNCTION getKeyByIndex_i1mm
1936	!==============================================================================================================================
1937	LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
1938	CHARACTER(LEN=*), INTENT(IN) :: keyn
1939	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1940	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1941	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1942	REAL, OPTIONAL, INTENT(IN) :: def
1943	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1944	lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
1945	END FUNCTION getKeyByIndex_r1mm
1946	!==============================================================================================================================
1947	LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
1948	CHARACTER(LEN=*), INTENT(IN) :: keyn
1949	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1950	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1951	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1952	LOGICAL, OPTIONAL, INTENT(IN) :: def
1953	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1954	lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
1955	END FUNCTION getKeyByIndex_l1mm
1956	!==============================================================================================================================
1957	!==============================================================================================================================
1958	LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
1959	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1960	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1961	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1962	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1963	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
1964	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
1965	!------------------------------------------------------------------------------------------------------------------------------
1966	CHARACTER(LEN=maxlen) :: s
1967	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
1968	INTEGER :: iq, nq(3), k
1969	LOGICAL :: lD, l(3)
1970	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
1971	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
1972	lerr = .TRUE.
1973	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
1974	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)%keys) !--- "tracers"
1975	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
1976	END IF
1977	IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
1978	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
1979
1980	!--- DEFAULT VALUE
1981	l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
1982	IF(l(1)) nq(1) = SIZE(ky)
1983	IF(l(2)) nq(2) = SIZE(tracers)
1984	IF(l(3)) nq(3) = SIZE(isotope%keys)
1985	DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
1986	lerr = k == 4
1987	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
1988	CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
1989
1990	CONTAINS
1991
1992	FUNCTION fgetKey(ky) RESULT(val)
1993	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
1994	TYPE(keys_type), INTENT(IN) :: ky(:)
1995	LOGICAL :: ler(SIZE(ky))
1996	INTEGER :: iq
1997	lerr = SIZE(ky) == 0; IF(lerr) RETURN
1998	tname = ky%name
1999	val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
2000	lerr = ANY(ler)
2001	END FUNCTION fgetKey
2002
2003	END FUNCTION getKeyByIndex_smmm
2004	!==============================================================================================================================
2005	LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
2006	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
2007	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2008	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2009	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
2010	INTEGER, OPTIONAL, INTENT(IN) :: def
2011	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2012	!------------------------------------------------------------------------------------------------------------------------------
2013	CHARACTER(LEN=maxlen) :: s
2014	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
2015	LOGICAL, ALLOCATABLE :: ll(:)
2016	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, num2str(def), lDisp)
2017	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
2018	IF(lerr) RETURN
2019	val = str2int(svals)
2020	ll = val == -HUGE(1)
2021	lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
2022	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
2023	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
2024	IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
2025	END FUNCTION getKeyByIndex_immm
2026	!==============================================================================================================================
2027	LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
2028	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
2029	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2030	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2031	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
2032	REAL, OPTIONAL, INTENT(IN) :: def
2033	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2034	!------------------------------------------------------------------------------------------------------------------------------
2035	CHARACTER(LEN=maxlen) :: s
2036	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
2037	LOGICAL, ALLOCATABLE :: ll(:)
2038	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, num2str(def), lDisp)
2039	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
2040	IF(lerr) RETURN
2041	val = str2real(svals)
2042	ll = val == -HUGE(1.)
2043	lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
2044	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
2045	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
2046	END FUNCTION getKeyByIndex_rmmm
2047	!==============================================================================================================================
2048	LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
2049	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
2050	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2051	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2052	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
2053	LOGICAL, OPTIONAL, INTENT(IN) :: def
2054	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2055	!------------------------------------------------------------------------------------------------------------------------------
2056	CHARACTER(LEN=maxlen) :: s
2057	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
2058	LOGICAL, ALLOCATABLE :: ll(:)
2059	INTEGER, ALLOCATABLE :: ivals(:)
2060	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, num2str(def), lDisp)
2061	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
2062	IF(lerr) RETURN
2063	ivals = str2bool(svals)
2064	ll = ivals == -1
2065	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN; END IF
2066	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2067	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
2068	END FUNCTION getKeyByIndex_lmmm
2069	!==============================================================================================================================
2070
2071
2072
2073	!==============================================================================================================================
2074	!=== GET KEYS VALUES FROM TRACERS NAMES ===
2075	!==============================================================================================================================
2076	!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN: ===
2077	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
2078	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
2079	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
2080	!=== * A SCALAR ===
2081	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
2082	!=== ===
2083	!=== SYNTAX: lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname [, ky(:)][, def][, lDisp]) ===
2084	!==============================================================================================================================
2085	!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)" ===
2086	!=== ===
2087	!=== SYNTAX lerr = getKeyByName_{sirl}{1m}mm (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp]) ===
2088	!==============================================================================================================================
2089	LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2090	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2091	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
2092	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2093	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
2094	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2095	lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
2096	END FUNCTION getKeyByName_s111
2097	!==============================================================================================================================
2098	LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2099	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2100	INTEGER, INTENT(OUT) :: val
2101	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2102	INTEGER, OPTIONAL, INTENT(IN) :: def
2103	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2104	lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
2105	END FUNCTION getKeyByName_i111
2106	!==============================================================================================================================
2107	LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2108	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2109	REAL , INTENT(OUT) :: val
2110	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2111	REAL, OPTIONAL, INTENT(IN) :: def
2112	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2113	lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
2114	END FUNCTION getKeyByName_r111
2115	!==============================================================================================================================
2116	LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2117	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2118	LOGICAL, INTENT(OUT) :: val
2119	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2120	LOGICAL, OPTIONAL, INTENT(IN) :: def
2121	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2122	lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
2123	END FUNCTION getKeyByName_l111
2124	!==============================================================================================================================
2125	!==============================================================================================================================
2126	LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2127	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2128	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
2129	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2130	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
2131	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2132	!------------------------------------------------------------------------------------------------------------------------------
2133	CHARACTER(LEN=maxlen) :: s, tnam
2134	LOGICAL :: lD
2135	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
2136	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
2137	lerr = .TRUE.
2138	tnam = strHead(delPhase(tname),'_',.TRUE.) !--- Remove phase and tag
2139	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
2140	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys) !--- "tracers"
2141	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
2142	IF(lerr .AND. PRESENT(def)) THEN
2143	val = def; lerr = .NOT.PRESENT(def)
2144	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
2145	END IF
2146	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
2147
2148	CONTAINS
2149
2150	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
2151	TYPE(keys_type), INTENT(IN) :: ky(:)
2152	lerr = SIZE(ky) == 0
2153	IF(lerr) RETURN
2154	val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
2155	IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam ), [keyn], ky, lerr)
2156
2157	END FUNCTION fgetKey
2158
2159	END FUNCTION getKeyByName_sm11
2160	!==============================================================================================================================
2161	LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2162	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2163	INTEGER, INTENT(OUT) :: val
2164	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2165	INTEGER, OPTIONAL, INTENT(IN) :: def
2166	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2167	!------------------------------------------------------------------------------------------------------------------------------
2168	CHARACTER(LEN=maxlen) :: sval, s
2169	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2170	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2171	IF(lerr) RETURN
2172	val = str2int(sval)
2173	lerr = val == -HUGE(1)
2174	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2175	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2176	END FUNCTION getKeyByName_im11
2177	!==============================================================================================================================
2178	LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2179	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2180	REAL , INTENT(OUT) :: val
2181	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2182	REAL, OPTIONAL, INTENT(IN) :: def
2183	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2184	!------------------------------------------------------------------------------------------------------------------------------
2185	CHARACTER(LEN=maxlen) :: sval, s
2186	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2187	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2188	IF(lerr) RETURN
2189	val = str2real(sval)
2190	lerr = val == -HUGE(1.)
2191	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2192	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2193	END FUNCTION getKeyByName_rm11
2194	!==============================================================================================================================
2195	LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2196	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2197	LOGICAL, INTENT(OUT) :: val
2198	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2199	LOGICAL, OPTIONAL, INTENT(IN) :: def
2200	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2201	!------------------------------------------------------------------------------------------------------------------------------
2202	CHARACTER(LEN=maxlen) :: sval, s
2203	INTEGER :: ival
2204	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2205	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2206	IF(lerr) RETURN
2207	ival = str2bool(sval)
2208	lerr = ival == -1
2209	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2210	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2211	IF(.NOT.lerr) val = ival == 1
2212	END FUNCTION getKeyByName_lm11
2213	!==============================================================================================================================
2214	!==============================================================================================================================
2215	LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2216	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2217	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2218	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2219	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2220	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2221	!------------------------------------------------------------------------------------------------------------------------------
2222	CHARACTER(LEN=maxlen) :: sval
2223	lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
2224	lerr = strParse(sval, ',', val)
2225	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2226	END FUNCTION getKeyByName_s1m1
2227	!==============================================================================================================================
2228	LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2229	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2230	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2231	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2232	INTEGER, OPTIONAL, INTENT(IN) :: def
2233	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2234	!------------------------------------------------------------------------------------------------------------------------------
2235	CHARACTER(LEN=maxlen) :: sval, s
2236	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2237	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, num2str(def), lDisp)
2238	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2239	IF(lerr) RETURN
2240	lerr = strParse(sval, ',', svals)
2241	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2242	val = str2int(svals)
2243	lerr = ANY(val == -HUGE(1))
2244	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2245	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2246	END FUNCTION getKeyByName_i1m1
2247	!==============================================================================================================================
2248	LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2249	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2250	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2251	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2252	REAL, OPTIONAL, INTENT(IN) :: def
2253	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2254	!------------------------------------------------------------------------------------------------------------------------------
2255	CHARACTER(LEN=maxlen) :: sval, s
2256	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2257	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, num2str(def), lDisp)
2258	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2259	IF(lerr) RETURN
2260	lerr = strParse(sval, ',', svals)
2261	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2262	val = str2real(svals)
2263	lerr = ANY(val == -HUGE(1.))
2264	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2265	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2266	END FUNCTION getKeyByName_r1m1
2267	!==============================================================================================================================
2268	LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2269	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
2270	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2271	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2272	LOGICAL, OPTIONAL, INTENT(IN) :: def
2273	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2274	!------------------------------------------------------------------------------------------------------------------------------
2275	CHARACTER(LEN=maxlen) :: sval, s
2276	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2277	INTEGER, ALLOCATABLE :: ivals(:)
2278	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, num2str(def), lDisp)
2279	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
2280	IF(lerr) RETURN
2281	lerr = strParse(sval, ',', svals)
2282	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2283	ivals = str2bool(svals)
2284	lerr = ANY(ivals == -1)
2285	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
2286	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2287	IF(.NOT.lerr) val = ivals == 1
2288	END FUNCTION getKeyByName_l1m1
2289	!==============================================================================================================================
2290	!==============================================================================================================================
2291	LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2292	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2293	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2294	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2295	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2296	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2297	!------------------------------------------------------------------------------------------------------------------------------
2298	CHARACTER(LEN=maxlen) :: sval
2299	lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
2300	lerr = strParse(sval, ',', val)
2301	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2302	END FUNCTION getKeyByName_smm1
2303	!==============================================================================================================================
2304	LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2305	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2306	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2307	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2308	INTEGER, OPTIONAL, INTENT(IN) :: def
2309	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2310	!------------------------------------------------------------------------------------------------------------------------------
2311	CHARACTER(LEN=maxlen) :: sval, s
2312	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2313	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2314	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2315	IF(lerr) RETURN
2316	lerr = strParse(sval, ',', svals)
2317	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2318	val = str2int(svals)
2319	lerr = ANY(val == -HUGE(1))
2320	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2321	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
2322	END FUNCTION getKeyByName_imm1
2323	!==============================================================================================================================
2324	LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2325	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2326	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2327	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2328	REAL, OPTIONAL, INTENT(IN) :: def
2329	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2330	!------------------------------------------------------------------------------------------------------------------------------
2331	CHARACTER(LEN=maxlen) :: sval, s
2332	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2333	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2334	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2335	IF(lerr) RETURN
2336	lerr = strParse(sval, ',', svals)
2337	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2338	val = str2real(svals)
2339	lerr = ANY(val == -HUGE(1.))
2340	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2341	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
2342	END FUNCTION getKeyByName_rmm1
2343	!==============================================================================================================================
2344	LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2345	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
2346	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2347	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2348	LOGICAL, OPTIONAL, INTENT(IN) :: def
2349	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2350	!------------------------------------------------------------------------------------------------------------------------------
2351	CHARACTER(LEN=maxlen) :: sval, s
2352	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2353	INTEGER, ALLOCATABLE :: ivals(:)
2354	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, num2str(def), lDisp)
2355	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
2356	IF(lerr) RETURN
2357	lerr = strParse(sval, ',', svals)
2358	CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
2359	ivals = str2bool(svals)
2360	lerr = ANY(ivals == -1)
2361	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
2362	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
2363	IF(.NOT.lerr) val = ivals == 1
2364	END FUNCTION getKeyByName_lmm1
2365	!==============================================================================================================================
2366	!==============================================================================================================================
2367	LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2368	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2369	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2370	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2371	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2372	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2373	lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
2374	END FUNCTION getKeyByName_s1mm
2375	!==============================================================================================================================
2376	LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2377	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2378	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2379	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2380	INTEGER, OPTIONAL, INTENT(IN) :: def
2381	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2382	lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
2383	END FUNCTION getKeyByName_i1mm
2384	!==============================================================================================================================
2385	LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2386	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2387	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2388	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2389	REAL, OPTIONAL, INTENT(IN) :: def
2390	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2391	lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
2392	END FUNCTION getKeyByName_r1mm
2393	!==============================================================================================================================
2394	LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2395	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
2396	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2397	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2398	LOGICAL, OPTIONAL, INTENT(IN) :: def
2399	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2400	lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
2401	END FUNCTION getKeyByName_l1mm
2402	!==============================================================================================================================
2403	!==============================================================================================================================
2404	LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2405	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2406	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
2407	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2408	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
2409	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2410	!------------------------------------------------------------------------------------------------------------------------------
2411	CHARACTER(LEN=maxlen) :: s
2412	INTEGER :: iq, nq
2413	LOGICAL :: lD
2414	nq = SIZE(tname); ALLOCATE(val(nq))
2415	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
2416	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
2417	lerr = .TRUE.
2418	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
2419	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)%keys) !--- "tracers"
2420	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
2421	END IF
2422	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
2423
2424	!--- DEFAULT VALUE
2425	val = [(def, iq = 1, SIZE(tname))]
2426	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
2427
2428	CONTAINS
2429
2430	FUNCTION fgetKey(ky) RESULT(val)
2431	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
2432	TYPE(keys_type), INTENT(IN) :: ky(:)
2433	LOGICAL, ALLOCATABLE :: ler(:)
2434	lerr = SIZE(ky) == 0; IF(lerr) RETURN
2435	ALLOCATE(ler(SIZE(tname)))
2436	val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
2437	lerr = ANY(ler)
2438	END FUNCTION fgetKey
2439
2440	END FUNCTION getKeyByName_smmm
2441	!==============================================================================================================================
2442	LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2443	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2444	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
2445	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2446	INTEGER, OPTIONAL, INTENT(IN) :: def
2447	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2448	!------------------------------------------------------------------------------------------------------------------------------
2449	CHARACTER(LEN=maxlen) :: s
2450	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2451	LOGICAL, ALLOCATABLE :: ll(:)
2452	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, num2str(def), lDisp)
2453	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2454	IF(lerr) RETURN
2455	val = str2int(svals)
2456	ll = val == -HUGE(1)
2457	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2458	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2459	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
2460	END FUNCTION getKeyByName_immm
2461	!==============================================================================================================================
2462	LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2463	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2464	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2465	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2466	REAL, OPTIONAL, INTENT(IN) :: def
2467	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2468	!------------------------------------------------------------------------------------------------------------------------------
2469	CHARACTER(LEN=maxlen) :: s
2470	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2471	LOGICAL, ALLOCATABLE :: ll(:)
2472	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, num2str(def), lDisp)
2473	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2474	IF(lerr) RETURN
2475	val = str2real(svals)
2476	ll = val == -HUGE(1.)
2477	lerr = ANY(ll); IF(.NOT.lerr) RETURN
2478	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2479	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
2480	END FUNCTION getKeyByName_rmmm
2481	!==============================================================================================================================
2482	LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
2483	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
2484	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
2485	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
2486	LOGICAL, OPTIONAL, INTENT(IN) :: def
2487	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
2488	!------------------------------------------------------------------------------------------------------------------------------
2489	CHARACTER(LEN=maxlen) :: s
2490	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
2491	LOGICAL, ALLOCATABLE :: ll(:)
2492	INTEGER, ALLOCATABLE :: ivals(:)
2493	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, num2str(def), lDisp)
2494	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
2495	IF(lerr) RETURN
2496	ivals = str2bool(svals)
2497	ll = ivals == -1
2498	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
2499	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
2500	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
2501	END FUNCTION getKeyByName_lmmm
2502	!==============================================================================================================================
2503
2504
2505	!==============================================================================================================================
2506	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
2507	!==============================================================================================================================
2508	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
2509	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
2510	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
2511	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
2512	!------------------------------------------------------------------------------------------------------------------------------
2513	TYPE(isot_type), ALLOCATABLE :: iso(:)
2514	INTEGER :: ix, nbIso
2515	IF(PRESENT( tracers_)) THEN; tracers = tracers_; ELSE; ALLOCATE( tracers(0)); END IF
2516	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
2517	IF(PRESENT(isotope_ )) THEN
2518	ix = strIdx(isotopes(:)%parent, isotope_%parent)
2519	IF(ix /= 0) THEN
2520	isotopes(ix) = isotope_
2521	ELSE
2522	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
2523	CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
2524	END IF
2525	END IF
2526	END SUBROUTINE setKeysDBase
2527	!==============================================================================================================================
2528	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
2529	TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
2530	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
2531	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
2532	!------------------------------------------------------------------------------------------------------------------------------
2533	INTEGER :: ix
2534	IF(PRESENT( tracers_)) THEN; tracers_ = tracers; ELSE; ALLOCATE( tracers_(0)); END IF
2535	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
2536	IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
2537	END SUBROUTINE getKeysDBase
2538	!==============================================================================================================================
2539
2540
2541	!==============================================================================================================================
2542	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
2543	!==============================================================================================================================
2544	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
2545	CHARACTER(LEN=*), INTENT(IN) :: s
2546	!------------------------------------------------------------------------------------------------------------------------------
2547	INTEGER :: ix, ip, ns
2548	out = s; ns = LEN_TRIM(s)
2549	IF(s == '' .OR. ns<=2) RETURN !--- Empty string or LEN(name)<=2: nothing to do
2550	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
2551	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
2552	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
2553	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
2554	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
2555	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
2556	END IF
2557	END FUNCTION delPhase
2558	!==============================================================================================================================
2559	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
2560	CHARACTER(LEN=*), INTENT(IN) :: s
2561	CHARACTER(LEN=1), INTENT(IN) :: pha
2562	!------------------------------------------------------------------------------------------------------------------------------
2563	INTEGER :: l, i
2564	out = s
2565	IF(s == '') RETURN !--- Empty string: nothing to do
2566	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
2567	l = LEN_TRIM(s)
2568	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
2569	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
2570	END FUNCTION addPhase_s1
2571	!==============================================================================================================================
2572	FUNCTION addPhase_sm(s,pha) RESULT(out)
2573	CHARACTER(LEN=*), INTENT(IN) :: s(:)
2574	CHARACTER(LEN=1), INTENT(IN) :: pha
2575	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
2576	!------------------------------------------------------------------------------------------------------------------------------
2577	INTEGER :: k
2578	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
2579	END FUNCTION addPhase_sm
2580	!==============================================================================================================================
2581	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
2582	CHARACTER(LEN=*), INTENT(IN) :: s
2583	INTEGER, INTENT(IN) :: ipha
2584	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2585	!------------------------------------------------------------------------------------------------------------------------------
2586	out = s
2587	IF(s == '') RETURN !--- Empty string: nothing to do
2588	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
2589	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
2590	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
2591	END FUNCTION addPhase_i1
2592	!==============================================================================================================================
2593	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
2594	CHARACTER(LEN=*), INTENT(IN) :: s(:)
2595	INTEGER, INTENT(IN) :: ipha
2596	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2597	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
2598	!------------------------------------------------------------------------------------------------------------------------------
2599	INTEGER :: k
2600	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
2601	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
2602	END FUNCTION addPhase_im
2603	!==============================================================================================================================
2604
2605
2606	!==============================================================================================================================
2607	!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
2608	!==============================================================================================================================
2609	LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
2610	CHARACTER(LEN=*), INTENT(IN) :: tname
2611	TYPE(keys_type), INTENT(IN) :: keys
2612	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
2613	TYPE(trac_type), ALLOCATABLE :: tr(:)
2614	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
2615	INTEGER :: nt, ix
2616	IF(ALLOCATED(tracs)) THEN
2617	lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
2618	nt = SIZE(tracs)
2619	ix = strIdx(tnames, tname)
2620	CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
2621	CALL msg('Appending with tracer "' //TRIM(tname)//'"', modname, ix == 0)
2622	IF(ix == 0) THEN
2623	ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
2624	END IF
2625	ELSE
2626	CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
2627	ix = 1; ALLOCATE(tracs(1))
2628	END IF
2629	CALL addKey('name', tname, tracs(ix)%keys)
2630	tracs(ix)%name = tname
2631	tracs(ix)%keys = keys
2632
2633	END FUNCTION addTracer_1
2634	!==============================================================================================================================
2635	LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
2636	CHARACTER(LEN=*), INTENT(IN) :: tname
2637	TYPE(keys_type), INTENT(IN) :: keys
2638	lerr = addTracer_1(tname, keys, tracers)
2639	END FUNCTION addTracer_1def
2640	!==============================================================================================================================
2641
2642
2643	!==============================================================================================================================
2644	LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
2645	CHARACTER(LEN=*), INTENT(IN) :: tname
2646	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
2647	TYPE(trac_type), ALLOCATABLE :: tr(:)
2648	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
2649	INTEGER :: nt, ix
2650	lerr = .NOT.ALLOCATED(tracs)
2651	CALL msg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr); IF(lerr) RETURN
2652	nt = SIZE(tracs)
2653	lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
2654	ix = strIdx(tnames, tname)
2655	CALL msg('Removing tracer "' //TRIM(tname)//'"', modname, ix /= 0)
2656	CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
2657	IF(ix /= 0) THEN
2658	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)
2659	END IF
2660	END FUNCTION delTracer_1
2661	!==============================================================================================================================
2662	LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
2663	CHARACTER(LEN=*), INTENT(IN) :: tname
2664	lerr = delTracer(tname, tracers)
2665	END FUNCTION delTracer_1def
2666	!==============================================================================================================================
2667
2668
2669	!==============================================================================================================================
2670	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
2671	!==============================================================================================================================
2672	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
2673	CHARACTER(LEN=*), INTENT(IN) :: tname
2674	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2675	!------------------------------------------------------------------------------------------------------------------------------
2676	CHARACTER(LEN=maxlen) :: phase
2677	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
2678	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
2679	END FUNCTION getiPhase
2680	!==============================================================================================================================
2681	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
2682	CHARACTER(LEN=*), INTENT(IN) :: tname
2683	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
2684	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2685	!------------------------------------------------------------------------------------------------------------------------------
2686	INTEGER :: ip
2687	phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
2688	IF( PRESENT(phases)) ip = INDEX( phases, phase)
2689	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
2690	IF(ip == 0) phase = 'g'
2691	IF(PRESENT(iPhase)) iPhase = ip
2692	END FUNCTION getPhase
2693	!==============================================================================================================================
2694
2695
2696	!==============================================================================================================================
2697	!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
2698	!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
2699	!==============================================================================================================================
2700	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
2701	CHARACTER(LEN=*), INTENT(IN) :: oldName
2702	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2703	!------------------------------------------------------------------------------------------------------------------------------
2704	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
2705	INTEGER :: ix, ip, nt
2706	LOGICAL :: lerr
2707	newName = oldName
2708	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
2709	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
2710	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
2711	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
2712	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
2713	IF(nt == 1) THEN
2714	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
2715	ELSE
2716	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
2717	IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name
2718	IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name
2719	IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER
2720	END IF
2721	END FUNCTION old2newH2O_1
2722	!==============================================================================================================================
2723	FUNCTION old2newH2O_m(oldName) RESULT(newName)
2724	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
2725	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
2726	!------------------------------------------------------------------------------------------------------------------------------
2727	INTEGER :: i
2728	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
2729	END FUNCTION old2newH2O_m
2730	!==============================================================================================================================
2731
2732
2733	!==============================================================================================================================
2734	!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
2735	!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
2736	!==============================================================================================================================
2737	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
2738	CHARACTER(LEN=*), INTENT(IN) :: newName
2739	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2740	!------------------------------------------------------------------------------------------------------------------------------
2741	INTEGER :: ix, ip
2742	CHARACTER(LEN=maxlen) :: var
2743	oldName = newName
2744	ip = getiPhase(newName) !--- Phase index
2745	IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous)
2746	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag
2747	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
2748	IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished
2749	oldName = 'H2O'
2750	IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip) !--- Add phase if needed
2751	IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix) !--- H2O isotope name
2752	IF(newName /= addPhase(var, ip)) &
2753	oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.) !--- Add the tag suffix
2754	IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix
2755	END FUNCTION new2oldH2O_1
2756	!==============================================================================================================================
2757	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
2758	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
2759	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
2760	!------------------------------------------------------------------------------------------------------------------------------
2761	INTEGER :: i
2762	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
2763	END FUNCTION new2oldH2O_m
2764	!==============================================================================================================================
2765
2766	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format