Context Navigation

readTracFiles_mod.f90 @ 5272

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

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

Download in other formats:

Original Format