Context Navigation

readTracFiles_mod.f90 @ 5353

Last change on this file since 5353 was 5353, checked in by yann meurdesoif, 13 days ago
Nvidia compiler has some difficulties to compile correctly some complex array constructor. This commit decompose it the several phases in order to achieve the compilation. Please Lionel and David, have a look to this in order to validate. Probably, in future, when compiler heuristic will be improved, this commit can be reversed. YM
File size: 175.6 KB

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

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

Download in other formats:

Original Format