Context Navigation

readTracFiles_mod.f90 @ 4996

Last change on this file since 4996 was 4987, checked in by dcugnet, 13 months ago

new functions to add/remove a phase: addPhase, delPhase
"str2bool" function is modified: result is O/1 for .FALSE./.TRUE. and -1 if the string was not a boolean.
"addKey(key[(:)], val[(:)], ky(:), [lOverWrite])" function is now more general:
- input argument "val" can be string/integer/real/logical
- key, val, key: add the <key> =<val> pair to ky
- key, val(:), key(:): add the <key> =<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
- key(:), val(:), key(:): add the <key(i)>=<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
few cosmetic changes

File size: 139.7 KB

Line
1	MODULE readTracFiles_mod
2
3	USE strings_mod, ONLY: msg, find, get_in, dispTable, strHead, strReduce, strFind, strStack, strIdx, &
4	test, 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	PUBLIC :: fGetKey, fGetKeys, setDirectKeys !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes TO BE REMOVED
20
21	PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
22	PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc)
23
24	PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
25
26	!=== FOR ISOTOPES: GENERAL
27	PUBLIC :: isot_type, readIsotopesFile, isoSelect, ixIso, nbIso!--- ISOTOPES READING ROUTINE + SELECTION + CLASS IDX & NUMBER
28
29	!=== FOR ISOTOPES: H2O FAMILY ONLY
30	PUBLIC :: iH2O
31
32	!=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
33	PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
34	PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
35	PUBLIC :: niso, nzone, nphas, ntiso !--- " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
36	PUBLIC :: itZonIso !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
37	PUBLIC :: iqIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx)
38	PUBLIC :: iqWIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx) but with normal water first
39	PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
40
41	PUBLIC :: maxTableWidth
42	!------------------------------------------------------------------------------------------------------------------------------
43	TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
44	CHARACTER(LEN=maxlen) :: name !--- Tracer name
45	CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:) !--- Keys string list
46	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:) !--- Corresponding values string list
47	END TYPE keys_type
48	!------------------------------------------------------------------------------------------------------------------------------
49	TYPE :: trac_type !=== TYPE FOR A SINGLE TRACER NAMED "name"
50	CHARACTER(LEN=maxlen) :: name = '' !--- Name of the tracer
51	TYPE(keys_type) :: keys !--- <key>=<val> pairs vector
52	CHARACTER(LEN=maxlen) :: gen0Name = '' !--- First generation ancestor name
53	CHARACTER(LEN=maxlen) :: parent = '' !--- Parent name
54	CHARACTER(LEN=maxlen) :: longName = '' !--- Long name (with advection scheme suffix)
55	CHARACTER(LEN=maxlen) :: type = 'tracer' !--- Type (so far: 'tracer' / 'tag')
56	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phase ('g'as / 'l'iquid / 's'olid)
57	CHARACTER(LEN=maxlen) :: component = '' !--- Coma-separated list of components (Ex: lmdz,inca)
58	INTEGER :: iGeneration = -1 !--- Generation number (>=0)
59	INTEGER :: iqParent = 0 !--- Parent index
60	INTEGER, ALLOCATABLE :: iqDescen(:) !--- Descendants index (in growing generation order)
61	INTEGER :: nqDescen = 0 !--- Number of descendants (all generations)
62	INTEGER :: nqChildren = 0 !--- Number of children (first generation)
63	INTEGER :: iadv = 10 !--- Advection scheme used
64	LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue
65	LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
66	INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:)
67	INTEGER :: iso_iName = 0 !--- Isotope name index in isotopes(iso_iGroup)%trac(:)
68	INTEGER :: iso_iZone = 0 !--- Isotope zone index in isotopes(iso_iGroup)%zone(:)
69	INTEGER :: iso_iPhase = 0 !--- Isotope phase index in isotopes(iso_iGroup)%phase
70	END TYPE trac_type
71	!------------------------------------------------------------------------------------------------------------------------------
72	TYPE :: isot_type !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
73	CHARACTER(LEN=maxlen) :: parent !--- Isotopes family name (parent tracer name ; ex: H2O)
74	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
75	LOGICAL :: check=.FALSE. !--- Flag for checking routines triggering
76	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
77	CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
78	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas)
79	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
80	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
81	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
82	INTEGER :: nphas = 0 !--- Number of phases
83	INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
84	!--- (former name: "iqiso"
85	INTEGER, ALLOCATABLE :: iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
86	!--- (former name: "?????")
87	INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
88	END TYPE isot_type !--- (former name: "index_trac")
89	!------------------------------------------------------------------------------------------------------------------------------
90	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
91	CHARACTER(LEN=maxlen) :: name !--- Section name
92	TYPE(trac_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
93	END TYPE dataBase_type
94	!------------------------------------------------------------------------------------------------------------------------------
95	INTERFACE getKey
96	MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
97	getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
98	getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
99	getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
100	END INTERFACE getKey
101	!------------------------------------------------------------------------------------------------------------------------------
102	INTERFACE addKey
103	MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
104	addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
105	END INTERFACE addKey
106	!------------------------------------------------------------------------------------------------------------------------------
107	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
108	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
109	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
110	INTERFACE fGetKey; MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1; END INTERFACE fGetKey
111	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
112	INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt; END INTERFACE idxAncestor
113	INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m, ancestor_mt; END INTERFACE ancestor
114	INTERFACE addTracer; MODULE PROCEDURE addTracer_1, addTracer_1def; END INTERFACE addTracer
115	INTERFACE delTracer; MODULE PROCEDURE delTracer_1, delTracer_1def; END INTERFACE delTracer
116	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
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(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, lRepr) RESULT(lerr)
193	!------------------------------------------------------------------------------------------------------------------------------
194	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
195	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNNO3 exceptions for REPROBUS
196	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
197	CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
198	INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
199	LOGICAL :: lRep
200	TYPE(keys_type), POINTER :: k
201	!------------------------------------------------------------------------------------------------------------------------------
202	lerr = .FALSE.
203	modname = 'readTracersFiles'
204	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
205	lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
206
207	!--- Required sections + corresponding files names (new style single section case) for tests
208	IF(test(testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections), lerr)) RETURN
209	nsec = SIZE(sections)
210
211	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
212	SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
213	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
214	CASE(1) !=== OLD FORMAT "traceur.def"
215	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
216	!--- OPEN THE "traceur.def" FILE
217	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
218
219	!--- GET THE TRACERS NUMBER
220	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
221	IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
222
223	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
224	IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
225	ALLOCATE(tracers(ntrac))
226	DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number
227	READ(90,'(a)',IOSTAT=ierr) str
228	IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
229	IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
230	lerr = strParse(str, ' ', s, ns)
231	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
232	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
233	k => tracers(it)%keys
234
235	!=== NAME OF THE TRACER
236	tname = old2newH2O(s(3), ip)
237	ix = strIdx(oldHNO3, s(3))
238	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
239	tracers(it)%name = tname !--- Set %name
240	CALL addKey_s11('name', tname, k) !--- Set the name of the tracer
241	tracers(it)%keys%name = tname !--- Copy tracers names in keys components
242
243	!=== NAME OF THE COMPONENT
244	cname = type_trac !--- Name of the model component
245	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
246	tracers(it)%component = cname !--- Set %component
247	CALL addKey_s11('component', cname, k) !--- Set the name of the model component
248
249	!=== NAME OF THE PARENT
250	pname = tran0 !--- Default name: default transporting fluid (air)
251	IF(ns == 4) THEN
252	pname = old2newH2O(s(4))
253	ix = strIdx(oldHNO3, s(4))
254	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
255	END IF
256	tracers(it)%parent = pname !--- Set %parent
257	CALL addKey_s11('parent', pname, k)
258
259	!=== PHASE AND ADVECTION SCHEMES NUMBERS
260	tracers(it)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase (default: "g"azeous)
261	CALL addKey_s11('phase', known_phases(ip:ip), k) !--- Set the phase of the tracer (default: "g"azeous)
262	CALL addKey_s11('hadv', s(1), k) !--- Set the horizontal advection schemes number
263	CALL addKey_s11('vadv', s(2), k) !--- Set the vertical advection schemes number
264	END DO
265	CLOSE(90)
266	IF(test(setGeneration(tracers), lerr)) RETURN !--- Set %iGeneration and %gen0Name
267	WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag' !--- Set %type: 'tracer' or 'tag'
268	DO it=1,ntrac
269	CALL addKey_s11('type', tracers(it)%type, tracers(it)%keys) !--- Set the type of tracer
270	END DO
271	IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN !--- Detect orphans and check phases
272	IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN !--- Detect repeated tracers
273	CALL sortTracers (tracers) !--- Sort the tracers
274	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
275	CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
276	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
277	CASE(3); IF(test(feedDBase( trac_files , sections, modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE SECTION
278	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
279	END SELECT
280	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
281	IF(ALL([2,3] /= fType)) RETURN
282
283	IF(nsec == 1) THEN;
284	tracers = dBase(1)%trac
285	ELSE IF(lTracsMerge) THEN
286	CALL msg('The multiple required sections will be MERGED.', modname)
287	IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
288	ELSE
289	CALL msg('The multiple required sections will be CUMULATED.', modname)
290	IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
291	END IF
292	CALL setDirectKeys(tracers) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
293	END FUNCTION readTracersFiles
294	!==============================================================================================================================
295
296
297	!==============================================================================================================================
298	LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
299	CHARACTER(LEN=*), INTENT(IN) :: modname, type_trac
300	INTEGER, INTENT(OUT) :: fType
301	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
302	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
303	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
304	LOGICAL, ALLOCATABLE :: ll(:)
305	LOGICAL :: lD, lFound
306	INTEGER :: is, nsec
307	lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
308	lerr = .FALSE.
309
310	!--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
311	!--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
312	IF(test(strParse(type_trac, '\|', sections, n=nsec), lerr)) RETURN !--- Parse "type_trac" list
313	IF(PRESENT(sects)) sects = sections
314	ALLOCATE(trac_files(nsec), ll(nsec))
315	DO is=1, nsec
316	trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'
317	INQUIRE(FILE=TRIM(trac_files(is)), EXIST=ll(is))
318	END DO
319	IF(PRESENT(tracf)) tracf = trac_files
320	fType = 0
321	INQUIRE(FILE='traceur.def', EXIST=lFound); IF(lFound) fType = 1 !--- OLD STYLE FILE
322	INQUIRE(FILE='tracer.def', EXIST=lFound); IF(lFound) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
323	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
324	IF(.NOT.lD) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
325	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
326	IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
327	END IF
328
329	!--- TELLS WHAT WAS IS ABOUT TO BE USED
330	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
331	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
332	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
333	END FUNCTION testTracersFiles
334	!==============================================================================================================================
335
336	!==============================================================================================================================
337	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
338	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
339	! file and create the corresponding tracers set descriptors in the database "dBase":
340	! * dBase(id)%name : section name
341	! * dBase(id)%trac(:)%name : tracers names
342	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
343	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
344	!------------------------------------------------------------------------------------------------------------------------------
345	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
346	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
347	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling routine name
348	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
349	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
350	CHARACTER(LEN=maxlen) :: fnm, snm
351	INTEGER :: idb, i
352	LOGICAL :: ll
353	!------------------------------------------------------------------------------------------------------------------------------
354	!=== READ THE REQUIRED SECTIONS
355	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
356	ALLOCATE(ixf(SUM(ndb)))
357	DO i=1, SIZE(fnames) !--- Set %name, %keys
358	IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
359	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
360	END DO
361	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
362	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
363	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
364	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
365	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
366	IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- EXPAND NAMES ; set %parent, %type, %component
367	IF(test(setGeneration(dBase(idb)%trac), lerr)) RETURN !--- set %iGeneration, %genOName
368	IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES
369	IF(test(checkUnique (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
370	CALL expandPhases (dBase(idb)%trac) !--- EXPAND PHASES ; set %phase
371	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
372	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
373	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
374	END DO
375	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
376	END FUNCTION feedDBase
377	!------------------------------------------------------------------------------------------------------------------------------
378
379	!------------------------------------------------------------------------------------------------------------------------------
380	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
381	!------------------------------------------------------------------------------------------------------------------------------
382	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
383	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Pipe-separated sections list
384	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
385	!------------------------------------------------------------------------------------------------------------------------------
386	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
387	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
388	INTEGER, ALLOCATABLE :: ix(:)
389	INTEGER :: n0, idb, ndb
390	LOGICAL :: ll
391	!------------------------------------------------------------------------------------------------------------------------------
392	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
393	CALL readSections_all() !--- Read all the sections of file "fnam"
394	ndb= SIZE(dBase) !--- Current number of sections in the database
395	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
396	DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
397	END IF
398	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
399	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
400	IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
401	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
402
403	CONTAINS
404
405	!------------------------------------------------------------------------------------------------------------------------------
406	SUBROUTINE readSections_all()
407	!------------------------------------------------------------------------------------------------------------------------------
408	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
409	TYPE(trac_type), ALLOCATABLE :: tt(:)
410	TYPE(trac_type) :: tmp
411	CHARACTER(LEN=1024) :: str, str2
412	CHARACTER(LEN=maxlen) :: secn
413	INTEGER :: ierr, n
414	!------------------------------------------------------------------------------------------------------------------------------
415	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
416	OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
417	DO; str=''
418	DO
419	READ(90,'(a)', IOSTAT=ierr)str2 !--- Read a full line
420	str=TRIM(str)//' '//TRIM(str2) !--- Append "str" with the current line
421	n=LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
422	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
423	str = str(1:n-1) !--- Remove the "\" continuing line symbol
424	END DO
425	str = ADJUSTL(str) !--- Remove the front space
426	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
427	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
428	CALL removeComment(str) !--- Skip comments at the end of a line
429	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
430	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
431	ndb = SIZE(dBase) !--- Number of sections so far
432	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
433	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
434	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
435	ndb = ndb + 1 !--- Extend database
436	ALLOCATE(tdb(ndb))
437	tdb(1:ndb-1) = dBase
438	tdb(ndb)%name = secn
439	ALLOCATE(tdb(ndb)%trac(0))
440	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
441	ELSE !=== TRACER LINE
442	ll = strParse(str,' ', s, n, v) !--- Parse <key>=<val> pairs
443	tt = dBase(ndb)%trac(:)
444	v(1) = s(1); s(1) = 'name' !--- Convert "name" into a regular key
445	tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:)) !--- Set %name and %keys
446	dBase(ndb)%trac = [tt(:), tmp]
447	DEALLOCATE(tt)
448	END IF
449	END DO
450	CLOSE(90)
451
452	END SUBROUTINE readSections_all
453	!------------------------------------------------------------------------------------------------------------------------------
454
455	END FUNCTION readSections
456	!==============================================================================================================================
457
458
459	!==============================================================================================================================
460	SUBROUTINE addDefault(t, defName)
461	!------------------------------------------------------------------------------------------------------------------------------
462	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
463	!------------------------------------------------------------------------------------------------------------------------------
464	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
465	CHARACTER(LEN=*), INTENT(IN) :: defName
466	INTEGER :: jd, it, k
467	TYPE(keys_type), POINTER :: ky
468	TYPE(trac_type), ALLOCATABLE :: tt(:)
469	jd = strIdx(t(:)%name, defName)
470	IF(jd == 0) RETURN
471	ky => t(jd)%keys
472	DO k = 1, SIZE(ky%key) !--- Loop on the keys of the tracer named "defName"
473	! CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.) !--- Add key to all the tracers (no overwriting)
474	DO it = 1, SIZE(t); CALL addKey_s11(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
475	END DO
476	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
477	END SUBROUTINE addDefault
478	!==============================================================================================================================
479
480	!==============================================================================================================================
481	SUBROUTINE subDefault(t, defName, lSubLocal)
482	!------------------------------------------------------------------------------------------------------------------------------
483	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
484	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
485	!------------------------------------------------------------------------------------------------------------------------------
486	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
487	CHARACTER(LEN=*), INTENT(IN) :: defName
488	LOGICAL, INTENT(IN) :: lSubLocal
489	INTEGER :: i0, it, ik
490	TYPE(keys_type), POINTER :: k0, ky
491	TYPE(trac_type), ALLOCATABLE :: tt(:)
492	i0 = strIdx(t(:)%name, defName)
493	IF(i0 == 0) RETURN
494	k0 => t(i0)%keys
495	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
496	ky => t(it)%keys
497
498	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
499	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
500
501	IF(.NOT.lSubLocal) CYCLE
502	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
503	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
504	END DO
505	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
506
507	END SUBROUTINE subDefault
508	!==============================================================================================================================
509
510
511	!==============================================================================================================================
512	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
513	!------------------------------------------------------------------------------------------------------------------------------
514	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
515	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
516	! * Default values are provided for these keys because they are necessary.
517	!------------------------------------------------------------------------------------------------------------------------------
518	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
519	CHARACTER(LEN=*), INTENT(IN) :: sname
520	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname
521	TYPE(trac_type), ALLOCATABLE :: ttr(:)
522	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
523	CHARACTER(LEN=maxlen) :: msg1, modname
524	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
525	LOGICAL :: ll
526	modname = 'expandSection'
527	lerr = .FALSE.
528	nt = SIZE(tr)
529	nq = 0
530	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
531	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
532	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
533	!--- Extract useful keys: parent name, type, component name
534	tr(it)%parent = fgetKey(it, 'parent', tr(:)%keys, tran0 )
535	tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer')
536	tr(it)%component = sname
537	! CALL addKey_s1m('component', sname, tr(:)%keys)
538	DO iq=1,SIZE(tr); CALL addKey_s11('component', sname, tr(iq)%keys); END DO
539
540	!--- Determine the number of tracers and parents ; coherence checking
541	ll = strCount(tr(it)%name, ',', ntr)
542	ll = strCount(tr(it)%parent, ',', npr)
543
544	!--- Tagging tracers only can have multiple parents
545	IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
546	msg1 = 'Check section "'//TRIM(sname)//'"'
547	IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
548	CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
549	END IF
550	nq = nq + ntr*npr
551	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
552	END DO
553	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
554
555	ALLOCATE(ttr(nq))
556	iq = 1
557	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
558	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
559	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
560	ll = strParse(tr(it)%name, ',', ta, ntr) !--- Number of tracers
561	ll = strParse(tr(it)%parent, ',', pa, npr) !--- Number of parents
562	DO ipr=1,npr !--- Loop on parents list elts
563	DO itr=1,ntr !--- Loop on tracers list elts
564	ttr(iq)%keys%key = tr(it)%keys%key
565	ttr(iq)%keys%val = tr(it)%keys%val
566	ttr(iq)%keys%name = ta(itr)
567	ttr(iq)%name = TRIM(ta(itr)); CALL addKey_s11('name', ta(itr), ttr(iq)%keys)
568	ttr(iq)%parent = TRIM(pa(ipr)); CALL addKey_s11('parent', pa(ipr), ttr(iq)%keys)
569	ttr(iq)%type = tr(it)%type; CALL addKey_s11('type', tr(it)%type, ttr(iq)%keys)
570	ttr(iq)%component = tr(it)%component; CALL addKey_s11('component', tr(it)%component, ttr(iq)%keys)
571	iq = iq+1
572	END DO
573	END DO
574	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
575	END DO
576	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
577	DEALLOCATE(ta,pa)
578	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
579
580	END FUNCTION expandSection
581	!==============================================================================================================================
582
583
584	!==============================================================================================================================
585	LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
586	!------------------------------------------------------------------------------------------------------------------------------
587	! Purpose: Determine, for each tracer of "tr(:)":
588	! * %iGeneration: the generation number
589	! * %gen0Name: the generation 0 ancestor name
590	! Check also for orphan tracers (tracers not descending on "tran0").
591	!------------------------------------------------------------------------------------------------------------------------------
592	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
593	INTEGER :: iq, jq, ig
594	CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
595	!------------------------------------------------------------------------------------------------------------------------------
596	CHARACTER(LEN=maxlen) :: modname
597	modname = 'setGeneration'
598	IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
599	DO iq = 1, SIZE(tr)
600	jq = iq; ig = 0
601	DO WHILE(parent(jq) /= tran0)
602	jq = strIdx(tr(:)%name, parent(jq))
603	IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
604	ig = ig + 1
605	END DO
606	tr(iq)%gen0Name = tr(jq)%name; CALL addKey_s11('gen0Name', tr(iq)%gen0Name, tr(iq)%keys)
607	tr(iq)%iGeneration = ig; CALL addKey_s11('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
608	END DO
609	END FUNCTION setGeneration
610	!==============================================================================================================================
611
612
613	!==============================================================================================================================
614	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
615	!------------------------------------------------------------------------------------------------------------------------------
616	! Purpose:
617	! * check for orphan tracers (without known parent)
618	! * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
619	!------------------------------------------------------------------------------------------------------------------------------
620	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
621	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
622	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
623	CHARACTER(LEN=maxlen) :: mesg
624	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
625	CHARACTER(LEN=1) :: p
626	INTEGER :: ip, np, iq, nq
627	!------------------------------------------------------------------------------------------------------------------------------
628	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
629	mesg = 'Check section "'//TRIM(sname)//'"'
630	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
631
632	!=== CHECK FOR ORPHAN TRACERS
633	IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
634
635	!=== CHECK PHASES
636	DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE !--- Generation O only is checked
637	pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases
638	np = LEN_TRIM(pha); bp(iq)=' '
639	DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
640	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
641	END DO
642	lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
643	END FUNCTION checkTracers
644	!==============================================================================================================================
645
646
647	!==============================================================================================================================
648	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
649	!------------------------------------------------------------------------------------------------------------------------------
650	! Purpose: Make sure that tracers are not repeated.
651	!------------------------------------------------------------------------------------------------------------------------------
652	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
653	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
654	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
655	!------------------------------------------------------------------------------------------------------------------------------
656	INTEGER :: ip, np, iq, nq, k
657	LOGICAL, ALLOCATABLE :: ll(:)
658	CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
659	CHARACTER(LEN=1) :: p
660	!------------------------------------------------------------------------------------------------------------------------------
661	mesg = 'Check section "'//TRIM(sname)//'"'
662	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
663	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
664	tdup(:) = ''
665	DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE !--- Tags can be repeated
666	tnam = TRIM(tr(iq)%name)
667	ll = tr(:)%name==TRIM(tnam) !--- Mask for current tracer name
668	IF(COUNT(ll)==1 ) CYCLE !--- Tracer is not repeated
669	IF(tr(iq)%iGeneration>0) THEN
670	tdup(iq) = tnam !--- gen>0: MUST be unique
671	ELSE
672	DO ip=1,nphases; p=known_phases(ip:ip) !--- Loop on known phases
673	!--- Number of appearances of the current tracer with known phase "p"
674	np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
675	IF(np <=1) CYCLE
676	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
677	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
678	END DO
679	END IF
680	IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
681	END DO
682	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
683	END FUNCTION checkUnique
684	!==============================================================================================================================
685
686
687	!==============================================================================================================================
688	SUBROUTINE expandPhases(tr)
689	!------------------------------------------------------------------------------------------------------------------------------
690	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
691	!------------------------------------------------------------------------------------------------------------------------------
692	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
693	!------------------------------------------------------------------------------------------------------------------------------
694	TYPE(trac_type), ALLOCATABLE :: ttr(:)
695	INTEGER, ALLOCATABLE :: i0(:)
696	CHARACTER(LEN=maxlen) :: nam, pha, tname
697	CHARACTER(LEN=1) :: p
698	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
699	LOGICAL :: lTag, lExt
700	!------------------------------------------------------------------------------------------------------------------------------
701	nq = SIZE(tr, DIM=1)
702	nt = 0
703	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
704	IF(tr(iq)%iGeneration /= 0) CYCLE !--- Only deal with generation 0 tracers
705	nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0) !--- Number of children of tr(iq)
706	tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys) !--- Phases list of tr(iq)
707	np = LEN_TRIM(tr(iq)%phase) !--- Number of phases of tr(iq)
708	nt = nt + (1+nc) * np !--- Number of tracers after expansion
709	END DO
710	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
711	it = 1 !--- Current "ttr(:)" index
712	DO iq = 1, nq !--- Loop on "tr(:)" indexes
713	lTag = tr(iq)%type=='tag' !--- Current tracer is a tag
714	i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n) !--- Indexes of first generation ancestor copies
715	np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1) !--- Number of phases for current tracer tr(iq)
716	lExt = np>1 !--- Phase suffix only required if phases number is > 1
717	IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0 !--- No phase suffix for generation 0 tags
718	DO i=1,n !=== LOOP ON GENERATION 0 ANCESTORS
719	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
720	IF(tr(iq)%iGeneration==0) jq=iq !--- Generation 0: count the current tracer phases only
721	pha = tr(jq)%phase !--- Phases list for tr(jq)
722	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
723	p = pha(ip:ip)
724	tname = TRIM(tr(iq)%name); nam = tname !--- Tracer name (regular case)
725	IF(lTag) nam = TRIM(tr(iq)%parent) !--- Parent name (tagging case)
726	IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed
727	IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname) !--- <parent>_<name> for tags
728	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
729	ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix
730	ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor
731	ttr(it)%phase = p !--- Single phase entry
732	CALL addKey_s11('name', nam, ttr(it)%keys)
733	CALL addKey_s11('phase', p, ttr(it)%keys)
734	IF(lExt .AND. tr(iq)%iGeneration>0) THEN
735	ttr(it)%parent = addPhase(tr(iq)%parent, p)
736	ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
737	CALL addKey_s11('parent', ttr(it)%parent, ttr(it)%keys)
738	CALL addKey_s11('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
739	END IF
740	it = it+1
741	END DO
742	IF(tr(iq)%iGeneration==0) EXIT !--- Break phase loop for gen 0
743	END DO
744	END DO
745	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
746	CALL delKey(['phases'],tr) !--- Remove few keys entries
747
748	END SUBROUTINE expandPhases
749	!==============================================================================================================================
750
751
752	!==============================================================================================================================
753	SUBROUTINE sortTracers(tr)
754	!------------------------------------------------------------------------------------------------------------------------------
755	! Purpose: Sort tracers:
756	! * Put water at the beginning of the vector, in the "known_phases" order.
757	! * lGrowGen == T: in ascending generations numbers.
758	! * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
759	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
760	!------------------------------------------------------------------------------------------------------------------------------
761	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
762	!------------------------------------------------------------------------------------------------------------------------------
763	TYPE(trac_type), ALLOCATABLE :: tr2(:)
764	INTEGER, ALLOCATABLE :: iy(:), iz(:)
765	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
766	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
767	!------------------------------------------------------------------------------------------------------------------------------
768	nq = SIZE(tr)
769	DO ip = nphases, 1, -1
770	iq = strIdx(tr(:)%name, addPhase('H2O', ip))
771	IF(iq == 0) CYCLE
772	tr2 = tr(:)
773	tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
774	END DO
775	IF(lSortByGen) THEN
776	iq = 1
777	ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations
778	DO ig = 0, ng !--- Loop on generations
779	iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig) !--- Generation ig tracers indexes
780	n = SIZE(iy)
781	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
782	iq = iq + n
783	END DO
784	ELSE
785	iq = 1
786	DO jq = 1, nq !--- Loop on generation 0 tracers
787	IF(tr(jq)%iGeneration /= 0) CYCLE !--- Skip generations /= 0
788	ix(iq) = jq !--- Generation 0 ancestor index first
789	iq = iq + 1 !--- Next "iq" for next generations tracers
790	iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name)) !--- Indexes of "tr(jq)" children in "tr(:)"
791	ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations of the "tr(jq)" family
792	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
793	iz = find(tr(iy)%iGeneration, ig, n) !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
794	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
795	iq = iq + n
796	END DO
797	END DO
798	END IF
799	tr = tr(ix) !--- Reorder the tracers
800	END SUBROUTINE sortTracers
801	!==============================================================================================================================
802
803
804	!==============================================================================================================================
805	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
806	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
807	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
808	TYPE(trac_type), POINTER :: t1(:), t2(:)
809	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
810	INTEGER :: is, k1, k2, nk2, i1, i2, nt2
811	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
812	modname = 'mergeTracers'
813	lerr = .FALSE.
814	t1 => sections(1)%trac(:) !--- Alias: first tracers section
815	tr = t1
816	!----------------------------------------------------------------------------------------------------------------------------
817	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
818	!----------------------------------------------------------------------------------------------------------------------------
819	t2 => sections(is)%trac(:) !--- Alias: current tracers section
820	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
821	ixct = strIdx(t1(:)%name, t2(:)%name) !--- Indexes of common tracers
822	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
823	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
824	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
825	CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
826	!--------------------------------------------------------------------------------------------------------------------------
827	DO i2=1,nt2; tnam = TRIM(t2(i2)%name) !=== LOOP ON COMMON TRACERS
828	!--------------------------------------------------------------------------------------------------------------------------
829	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
830
831	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
832	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
833
834	IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent /= t2(i2)%parent), lerr)) RETURN
835	IF(test(fmsg('Type' //TRIM(s1), modname, t1(i1)%type /= t2(i2)%type), lerr)) RETURN
836	IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
837
838	!=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
839	nk2 = SIZE(t2(i2)%keys%key(:)) !--- Keys number in current section
840	ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:)) !--- Common keys indexes
841
842	!=== APPEND NEW KEYS
843	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
844	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
845
846	!--- KEEP TRACK OF THE COMPONENTS NAMES
847	tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
848
849	!--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
850	DO k2=1,nk2
851	k1 = ixck(k2); IF(k1 == 0) CYCLE
852	IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
853	END DO
854	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values
855
856	!--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
857	CALL msg('Key(s)'//TRIM(s1), modname)
858	DO k2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
859	knam = t2(i2)%keys%key(k2) !--- Name of the current key
860	k1 = ixck(k2) !--- Corresponding index in t1(:)
861	IF(k1 == 0) CYCLE !--- New keys are skipped
862	v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2) !--- Key values in t1(:) and t2(:)
863	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
864	END DO
865	!------------------------------------------------------------------------------------------------------------------------
866	END DO
867	!--------------------------------------------------------------------------------------------------------------------------
868	END DO
869	CALL sortTracers(tr)
870
871	END FUNCTION mergeTracers
872	!==============================================================================================================================
873
874	!==============================================================================================================================
875	LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
876	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
877	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
878	TYPE(trac_type), POINTER :: t(:)
879	INTEGER, ALLOCATABLE :: nt(:)
880	CHARACTER(LEN=maxlen) :: tnam, tnam_new
881	INTEGER :: iq, nq, is, ns, nsec
882	lerr = .FALSE. !--- Can't fail ; kept to match "mergeTracer" interface.
883	nsec = SIZE(sections)
884	tr = [( sections(is)%trac(:) , is=1, nsec )] !--- Concatenated tracers vector
885	nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )] !--- Number of tracers in each section
886	!----------------------------------------------------------------------------------------------------------------------------
887	DO is=1, nsec !=== LOOP ON SECTIONS
888	!----------------------------------------------------------------------------------------------------------------------------
889	t => sections(is)%trac(:)
890	!--------------------------------------------------------------------------------------------------------------------------
891	DO iq=1, nt(is) !=== LOOP ON TRACERS
892	!--------------------------------------------------------------------------------------------------------------------------
893	tnam = TRIM(t(iq)%name) !--- Original name
894	IF(COUNT(t%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished
895	tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension
896	nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections
897	ns = nt(is) !--- Number of tracers in the current section
898	tr(iq + nq)%name = TRIM(tnam_new) !--- Modify tracer name
899	WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new !--- Modify parent name
900	!--------------------------------------------------------------------------------------------------------------------------
901	END DO
902	!----------------------------------------------------------------------------------------------------------------------------
903	END DO
904	!----------------------------------------------------------------------------------------------------------------------------
905	CALL sortTracers(tr)
906	END FUNCTION cumulTracers
907	!==============================================================================================================================
908
909	!==============================================================================================================================
910	SUBROUTINE setDirectKeys(tr)
911	TYPE(trac_type), INTENT(INOUT) :: tr(:)
912
913	!--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
914	CALL indexUpdate(tr)
915
916	!--- Extract some direct-access keys
917	! DO iq = 1, SIZE(tr)
918	! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
919	! END DO
920	END SUBROUTINE setDirectKeys
921	!==============================================================================================================================
922
923	!==============================================================================================================================
924	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
925	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
926	INTEGER :: idb, iq, nq
927	INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
928	CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
929	TYPE(trac_type), POINTER :: tm(:)
930	lerr = .FALSE.
931	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
932	tm => dBase(idb)%trac
933	nq = SIZE(tm)
934	!--- BEWARE ! Can't use the "getKeyByName" functions yet.
935	! Names must first include the phases for tracers defined on multiple lines.
936	hadv = str2int(fgetKeys('hadv', tm(:)%keys, '10'))
937	vadv = str2int(fgetKeys('vadv', tm(:)%keys, '10'))
938	prnt = fgetKeys('parent',tm(:)%keys, '' )
939	IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKeys('phase', tm(:)%keys, 'g')
940	CALL msg(TRIM(message)//':', modname)
941	IF(ALL(prnt == 'air')) THEN
942	IF(test(dispTable('iiiss', ['iq ','hadv ','vadv ','name ','phase '], cat(tm%name, phas), &
943	cat([(iq, iq=1, nq)], hadv, vadv), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
944	ELSE IF(ALL(tm%iGeneration == -1)) THEN
945	IF(test(dispTable('iiisss', ['iq ','hadv ','vadv ','name ','parent','phase '], cat(tm%name, prnt, phas), &
946	cat([(iq, iq=1, nq)], hadv, vadv), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
947	ELSE
948	IF(test(dispTable('iiissis', ['iq ','hadv ','vadv ','name ','parent','igen ','phase '], cat(tm%name, prnt, phas), &
949	cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
950	END IF
951	END FUNCTION dispTraSection
952	!==============================================================================================================================
953
954
955	!==============================================================================================================================
956	!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
957	!==============================================================================================================================
958	FUNCTION aliasTracer(tname, t) RESULT(out)
959	TYPE(trac_type), POINTER :: out
960	CHARACTER(LEN=*), INTENT(IN) :: tname
961	TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
962	INTEGER :: it
963	it = strIdx(t(:)%name, tname)
964	out => NULL(); IF(it /= 0) out => t(it)
965	END FUNCTION aliasTracer
966	!==============================================================================================================================
967
968
969	!==============================================================================================================================
970	!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
971	!==============================================================================================================================
972	FUNCTION trSubset_Indx(trac,idx) RESULT(out)
973	TYPE(trac_type), ALLOCATABLE :: out(:)
974	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
975	INTEGER, INTENT(IN) :: idx(:)
976	out = trac(idx)
977	CALL indexUpdate(out)
978	END FUNCTION trSubset_Indx
979	!------------------------------------------------------------------------------------------------------------------------------
980	FUNCTION trSubset_Name(trac,nam) RESULT(out)
981	TYPE(trac_type), ALLOCATABLE :: out(:)
982	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
983	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
984	out = trac(strIdx(trac(:)%name, nam))
985	CALL indexUpdate(out)
986	END FUNCTION trSubset_Name
987	!==============================================================================================================================
988
989
990	!==============================================================================================================================
991	!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
992	!==============================================================================================================================
993	FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
994	TYPE(trac_type), ALLOCATABLE :: out(:)
995	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
996	CHARACTER(LEN=*), INTENT(IN) :: nam
997	out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
998	CALL indexUpdate(out)
999	END FUNCTION trSubset_gen0Name
1000	!==============================================================================================================================
1001
1002
1003	!==============================================================================================================================
1004	!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
1005	!==============================================================================================================================
1006	SUBROUTINE indexUpdate(tr)
1007	TYPE(trac_type), INTENT(INOUT) :: tr(:)
1008	INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
1009	tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index
1010	DO iq = 1, SIZE(tr); CALL addKey_s11('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
1011	ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
1012	DO iq = 1, SIZE(tr)
1013	ig = tr(iq)%iGeneration
1014	IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
1015	ALLOCATE(tr(iq)%iqDescen(0))
1016	CALL idxAncestor(tr, ix, ig) !--- Ancestor of generation "ng" for each tr
1017	DO igen = ig+1, ngen
1018	tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
1019	tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
1020	IF(igen == ig+1) THEN
1021	tr(iq)%nqChildren = tr(iq)%nqDescen
1022	CALL addKey_s11('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
1023	END IF
1024	END DO
1025	CALL addKey_s11('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
1026	CALL addKey_s11('nqDescen', int2str(tr(iq)%nqDescen) , tr(iq)%keys)
1027	END DO
1028	END SUBROUTINE indexUpdate
1029	!==============================================================================================================================
1030
1031
1032	!==============================================================================================================================
1033	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
1034	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
1035	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
1036	!=== NOTES: ====
1037	!=== * Most of the "isot" components have been defined in the calling routine (readIsotopes): ====
1038	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
1039	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
1040	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
1041	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
1042	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
1043	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
1044	!==============================================================================================================================
1045	LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
1046	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
1047	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!)
1048	LOGICAL :: lFound
1049	INTEGER :: is, iis, it, idb, ndb, nb0
1050	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
1051	CHARACTER(LEN=maxlen) :: modname
1052	TYPE(trac_type), POINTER :: tt(:), t
1053	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
1054	modname = 'readIsotopesFile'
1055
1056	!--- THE INPUT FILE MUST BE PRESENT
1057	INQUIRE(FILE=TRIM(fnam), EXIST=lFound); lerr = .NOT.lFound
1058	IF(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)) RETURN
1059
1060	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
1061	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
1062	IF(test(readSections(fnam,strStack(isot(:)%parent,'\|')),lerr)) RETURN !--- Read sections, one each parent tracer
1063	ndb = SIZE(dBase, DIM=1) !--- Current database size
1064	DO idb = nb0, ndb
1065	iis = idb-nb0+1
1066
1067	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
1068	CALL addKeysFromDef(dBase(idb)%trac, 'params')
1069
1070	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
1071	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
1072
1073	tt => dBase(idb)%trac
1074
1075	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
1076	DO it = 1, SIZE(dBase(idb)%trac)
1077	t => dBase(idb)%trac(it)
1078	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
1079	IF(is == 0) CYCLE
1080	IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN !--- Reduce expressions ; detect non-numerical elements
1081	isot(iis)%keys(is)%key = t%keys%key
1082	isot(iis)%keys(is)%val = vals
1083	END DO
1084
1085	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
1086	IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
1087	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
1088	END DO
1089
1090	!--- CLEAN THE DATABASE ENTRIES
1091	IF(nb0 == 1) THEN
1092	DEALLOCATE(dBase); ALLOCATE(dBase(0))
1093	ELSE
1094	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
1095	END IF
1096
1097	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
1098	CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
1099
1100	lerr = dispIsotopes()
1101
1102	CONTAINS
1103
1104	!------------------------------------------------------------------------------------------------------------------------------
1105	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
1106	INTEGER :: ik, nk, ip, it, nt
1107	CHARACTER(LEN=maxlen) :: prf
1108	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
1109	CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
1110	DO ip = 1, SIZE(isot) !--- Loop on parents tracers
1111	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
1112	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
1113	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
1114	ALLOCATE(ttl(nk+2), val(nt,nk+1))
1115	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
1116	val(:,1) = isot(ip)%keys(:)%name !--- Values table 1st column: isotopes names
1117	DO ik = 1, nk
1118	DO it = 1, nt
1119	val(it,ik+1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
1120	END DO
1121	END DO
1122	IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
1123	cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
1124	DEALLOCATE(ttl, val)
1125	END DO
1126	END FUNCTION dispIsotopes
1127	!------------------------------------------------------------------------------------------------------------------------------
1128
1129	END FUNCTION readIsotopesFile_prv
1130	!==============================================================================================================================
1131
1132
1133	!==============================================================================================================================
1134	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
1135	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
1136	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
1137	!=== * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
1138	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
1139	!==============================================================================================================================
1140	LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
1141	CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN) :: iNames(:)
1142	CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
1143	CHARACTER(LEN=maxlen) :: iName, modname
1144	CHARACTER(LEN=1) :: ph !--- Phase
1145	INTEGER :: ic, ip, iq, it, iz
1146	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
1147	TYPE(trac_type), POINTER :: t(:), t1
1148	TYPE(isot_type), POINTER :: i
1149	lerr = .FALSE.
1150	modname = 'readIsotopesFile'
1151
1152	t => tracers
1153
1154	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
1155	p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
1156	CALL strReduce(p, nbIso)
1157
1158	!--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
1159	IF(PRESENT(iNames)) THEN
1160	DO it = 1, SIZE(iNames)
1161	IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
1162	END DO
1163	p = iNames; nbIso = SIZE(p)
1164	END IF
1165	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
1166	ALLOCATE(isotopes(nbIso))
1167
1168	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
1169
1170	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
1171	isotopes(:)%parent = p
1172	DO ic = 1, SIZE(p) !--- Loop on isotopes classes
1173	i => isotopes(ic)
1174	iname = i%parent !--- Current isotopes class name (parent tracer name)
1175
1176	!=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
1177	ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
1178	str = PACK(delPhase(t(:)%name), MASK = ll) !--- Effectively found isotopes of "iname"
1179	i%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
1180	ALLOCATE(i%keys(i%niso))
1181	FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
1182
1183	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
1184	ll = t(:)%type=='tag' .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
1185	i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
1186	CALL strReduce(i%zone)
1187	i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname"
1188
1189	!=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
1190	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
1191	str = PACK(delPhase(t(:)%name), MASK=ll)
1192	CALL strReduce(str)
1193	i%ntiso = i%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntiso]
1194	ALLOCATE(i%trac(i%ntiso))
1195	FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
1196	FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
1197
1198	!=== Phases for tracer "iname"
1199	i%phase = ''
1200	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
1201	i%nphas = LEN_TRIM(i%phase) !--- Equal to "nqo" for water
1202
1203	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
1204	DO iq = 1, SIZE(t)
1205	t1 => tracers(iq)
1206	IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname"
1207	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
1208	t1%iso_iName = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope idx in effective isotopes list
1209	t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone idx in effective zones list
1210	t1%iso_iPhase = INDEX(i%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
1211	IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers
1212	END DO
1213
1214	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
1215	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1216	i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], &
1217	[i%ntiso, i%nphas] )
1218	!=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
1219	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1220	i%iqWIsoPha = RESHAPE( [( [strIdx(t%name, addPhase('H2O',i%phase(ip:ip))), i%iqIsoPha(:,ip)], ip=1,i%nphas)], &
1221	[1+i%ntiso, i%nphas] )
1222	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
1223	i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
1224	[i%nzone, i%niso] )
1225	END DO
1226
1227	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE
1228	! IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN! on commente pour ne pas chercher isotopes_params.def
1229
1230	!=== CHECK CONSISTENCY
1231	IF(test(testIsotopes(), lerr)) RETURN
1232
1233	!=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
1234	IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
1235
1236	CONTAINS
1237
1238	!------------------------------------------------------------------------------------------------------------------------------
1239	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
1240	!------------------------------------------------------------------------------------------------------------------------------
1241	INTEGER :: ix, it, ip, np, iz, nz
1242	TYPE(isot_type), POINTER :: i
1243	DO ix = 1, nbIso
1244	i => isotopes(ix)
1245	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
1246	DO it = 1, i%ntiso
1247	np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
1248	IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
1249	modname, np /= i%nphas), lerr)) RETURN
1250	END DO
1251	DO it = 1, i%niso
1252	nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
1253	IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
1254	modname, nz /= i%nzone), lerr)) RETURN
1255	END DO
1256	END DO
1257	END FUNCTION testIsotopes
1258	!------------------------------------------------------------------------------------------------------------------------------
1259
1260	END FUNCTION readIsotopesFile
1261	!==============================================================================================================================
1262
1263
1264	!==============================================================================================================================
1265	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
1266	! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
1267	!==============================================================================================================================
1268	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
1269	IMPLICIT NONE
1270	CHARACTER(LEN=*), INTENT(IN) :: iName
1271	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1272	INTEGER :: iIso
1273	LOGICAL :: lV
1274	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
1275	iIso = strIdx(isotopes(:)%parent, iName)
1276	IF(test(iIso == 0, lerr)) THEN
1277	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
1278	CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
1279	RETURN
1280	END IF
1281	lerr = isoSelectByIndex(iIso, lV)
1282	END FUNCTION isoSelectByName
1283	!==============================================================================================================================
1284	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
1285	IMPLICIT NONE
1286	INTEGER, INTENT(IN) :: iIso
1287	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
1288	LOGICAL :: lV
1289	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
1290	lerr = .FALSE.
1291	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
1292	lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
1293	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
1294	//TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
1295	IF(lerr) RETURN
1296	ixIso = iIso !--- Update currently selected family index
1297	isotope => isotopes(ixIso) !--- Select corresponding component
1298	isoKeys => isotope%keys; niso = isotope%niso
1299	isoName => isotope%trac; ntiso = isotope%ntiso
1300	isoZone => isotope%zone; nzone = isotope%nzone
1301	isoPhas => isotope%phase; nphas = isotope%nphas
1302	itZonIso => isotope%itZonIso; isoCheck = isotope%check
1303	iqIsoPha => isotope%iqIsoPha
1304	iqWIsoPha => isotope%iqWIsoPha
1305	END FUNCTION isoSelectByIndex
1306	!==============================================================================================================================
1307
1308
1309	!==============================================================================================================================
1310	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
1311	!==============================================================================================================================
1312	SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
1313	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1314	TYPE(keys_type), INTENT(INOUT) :: ky
1315	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1316	!------------------------------------------------------------------------------------------------------------------------------
1317	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1318	INTEGER :: iky, nky
1319	LOGICAL :: lo
1320	lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
1321	IF(.NOT.ALLOCATED(ky%key)) THEN
1322	ALLOCATE(ky%key(1)); ky%key(1)=key
1323	ALLOCATE(ky%val(1)); ky%val(1)=sval
1324	RETURN
1325	END IF
1326	iky = strIdx(ky%key,key)
1327	IF(iky == 0) THEN
1328	nky = SIZE(ky%key)
1329	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
1330	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
1331	ELSE IF(lo) THEN
1332	ky%key(iky) = key; ky%val(iky) = sval
1333	END IF
1334	END SUBROUTINE addKey_s11
1335	!==============================================================================================================================
1336	SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
1337	CHARACTER(LEN=*), INTENT(IN) :: key
1338	INTEGER, INTENT(IN) :: ival
1339	TYPE(keys_type), INTENT(INOUT) :: ky
1340	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1341	!------------------------------------------------------------------------------------------------------------------------------
1342	CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
1343	END SUBROUTINE addKey_i11
1344	!==============================================================================================================================
1345	SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
1346	CHARACTER(LEN=*), INTENT(IN) :: key
1347	REAL, INTENT(IN) :: rval
1348	TYPE(keys_type), INTENT(INOUT) :: ky
1349	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1350	!------------------------------------------------------------------------------------------------------------------------------
1351	CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
1352	END SUBROUTINE addKey_r11
1353	!==============================================================================================================================
1354	SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
1355	CHARACTER(LEN=*), INTENT(IN) :: key
1356	LOGICAL, INTENT(IN) :: lval
1357	TYPE(keys_type), INTENT(INOUT) :: ky
1358	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1359	!------------------------------------------------------------------------------------------------------------------------------
1360	CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
1361	END SUBROUTINE addKey_l11
1362	!==============================================================================================================================
1363	!==============================================================================================================================
1364	SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
1365	CHARACTER(LEN=*), INTENT(IN) :: key, sval
1366	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1367	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1368	!------------------------------------------------------------------------------------------------------------------------------
1369	INTEGER :: itr
1370	DO itr = 1, SIZE(ky)
1371	CALL addKey_s11(key, sval, ky(itr), lOverWrite)
1372	END DO
1373	END SUBROUTINE addKey_s1m
1374	!==============================================================================================================================
1375	SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
1376	CHARACTER(LEN=*), INTENT(IN) :: key
1377	INTEGER, INTENT(IN) :: ival
1378	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1379	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1380	!------------------------------------------------------------------------------------------------------------------------------
1381	INTEGER :: itr
1382	DO itr = 1, SIZE(ky)
1383	CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite)
1384	END DO
1385	END SUBROUTINE addKey_i1m
1386	!==============================================================================================================================
1387	SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
1388	CHARACTER(LEN=*), INTENT(IN) :: key
1389	REAL, INTENT(IN) :: rval
1390	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1391	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1392	!------------------------------------------------------------------------------------------------------------------------------
1393	INTEGER :: itr
1394	DO itr = 1, SIZE(ky)
1395	CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite)
1396	END DO
1397	END SUBROUTINE addKey_r1m
1398	!==============================================================================================================================
1399	SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
1400	CHARACTER(LEN=*), INTENT(IN) :: key
1401	LOGICAL, INTENT(IN) :: lval
1402	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1403	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1404	!------------------------------------------------------------------------------------------------------------------------------
1405	INTEGER :: itr
1406	DO itr = 1, SIZE(ky)
1407	CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite)
1408	END DO
1409	END SUBROUTINE addKey_l1m
1410	!==============================================================================================================================
1411	!==============================================================================================================================
1412	SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
1413	CHARACTER(LEN=*), INTENT(IN) :: key, sval(:)
1414	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1415	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1416	!------------------------------------------------------------------------------------------------------------------------------
1417	INTEGER :: itr
1418	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
1419	END SUBROUTINE addKey_smm
1420	!==============================================================================================================================
1421	SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
1422	CHARACTER(LEN=*), INTENT(IN) :: key
1423	INTEGER, INTENT(IN) :: ival(:)
1424	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1425	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1426	!------------------------------------------------------------------------------------------------------------------------------
1427	INTEGER :: itr
1428	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
1429	END SUBROUTINE addKey_imm
1430	!==============================================================================================================================
1431	SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
1432	CHARACTER(LEN=*), INTENT(IN) :: key
1433	REAL, INTENT(IN) :: rval(:)
1434	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1435	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1436	!------------------------------------------------------------------------------------------------------------------------------
1437	INTEGER :: itr
1438	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
1439	END SUBROUTINE addKey_rmm
1440	!==============================================================================================================================
1441	SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
1442	CHARACTER(LEN=*), INTENT(IN) :: key
1443	LOGICAL, INTENT(IN) :: lval(:)
1444	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1445	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1446	!------------------------------------------------------------------------------------------------------------------------------
1447	INTEGER :: itr
1448	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
1449	END SUBROUTINE addKey_lmm
1450	!==============================================================================================================================
1451
1452
1453	!==============================================================================================================================
1454	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
1455	!==============================================================================================================================
1456	SUBROUTINE addKeysFromDef(t, tr0)
1457	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
1458	CHARACTER(LEN=*), INTENT(IN) :: tr0
1459	!------------------------------------------------------------------------------------------------------------------------------
1460	CHARACTER(LEN=maxlen) :: val
1461	INTEGER :: ik, jd
1462	jd = strIdx(t%name, tr0)
1463	IF(jd == 0) RETURN
1464	DO ik = 1, SIZE(t(jd)%keys%key)
1465	CALL get_in(t(jd)%keys%key(ik), val, 'none')
1466	IF(val /= 'none') CALL addKey_s11(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
1467	END DO
1468	END SUBROUTINE addKeysFromDef
1469	!==============================================================================================================================
1470
1471
1472	!==============================================================================================================================
1473	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
1474	!==============================================================================================================================
1475	SUBROUTINE delKey_1(itr, keyn, ky)
1476	INTEGER, INTENT(IN) :: itr
1477	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1478	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1479	!------------------------------------------------------------------------------------------------------------------------------
1480	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1481	LOGICAL, ALLOCATABLE :: ll(:)
1482	INTEGER :: iky
1483	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
1484	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
1485	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
1486	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
1487	END SUBROUTINE delKey_1
1488	!==============================================================================================================================
1489	SUBROUTINE delKey(keyn, ky)
1490	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1491	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1492	!------------------------------------------------------------------------------------------------------------------------------
1493	INTEGER :: iky
1494	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
1495	END SUBROUTINE delKey
1496	!==============================================================================================================================
1497
1498
1499	!==============================================================================================================================
1500	!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
1501	!==============================================================================================================================
1502	CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
1503	INTEGER, INTENT(IN) :: itr
1504	CHARACTER(LEN=*), INTENT(IN) :: keyn
1505	TYPE(keys_type), INTENT(IN) :: ky(:)
1506	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1507	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1508	!------------------------------------------------------------------------------------------------------------------------------
1509	INTEGER :: iky
1510	LOGICAL :: ler
1511	iky = 0; val = ''
1512	IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn) !--- Correct index
1513	IF(.NOT.test(iky == 0, ler)) val = ky(itr)%val(iky) !--- Found key
1514	IF(iky == 0) THEN
1515	IF(.NOT.test(.NOT.PRESENT(def_val), ler)) val = def_val !--- Default value
1516	END IF
1517	IF(PRESENT(lerr)) lerr = ler
1518	END FUNCTION fgetKeyIdx_s1
1519	!==============================================================================================================================
1520	CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
1521	CHARACTER(LEN=*), INTENT(IN) :: tname, keyn
1522	TYPE(keys_type), INTENT(IN) :: ky(:)
1523	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1524	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1525	!------------------------------------------------------------------------------------------------------------------------------
1526	val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
1527	END FUNCTION fgetKeyNam_s1
1528	!==============================================================================================================================
1529	FUNCTION fgetKeys(keyn, ky, def_val, lerr) RESULT(val)
1530	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
1531	CHARACTER(LEN=*), INTENT(IN) :: keyn
1532	TYPE(keys_type), INTENT(IN) :: ky(:)
1533	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1534	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1535	!------------------------------------------------------------------------------------------------------------------------------
1536	LOGICAL :: ler(SIZE(ky))
1537	INTEGER :: it
1538	val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
1539	IF(PRESENT(lerr)) lerr = ANY(ler)
1540	END FUNCTION fgetKeys
1541	!==============================================================================================================================
1542
1543
1544	!==============================================================================================================================
1545	!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE ==============
1546	!========== The key "keyn" is searched in: 1) "ky(:)%name" (if given) ==============
1547	!========== 2) "tracers(:)%name" ==============
1548	!========== 3) "isotope%keys(:)%name" ==============
1549	!========== for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
1550	!========== The type of the returned value(s) can be string, integer or real, scalar or vector ==============
1551	!==============================================================================================================================
1552	LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
1553	CHARACTER(LEN=*), INTENT(IN) :: keyn
1554	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1555	CHARACTER(LEN=*), INTENT(IN) :: tname
1556	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1557	!------------------------------------------------------------------------------------------------------------------------------
1558	CHARACTER(LEN=maxlen) :: tnam
1559	tnam = strHead(delPhase(tname),'_',.TRUE.) !--- Remove phase and tag
1560	IF(PRESENT(ky)) THEN !=== KEY FROM "ky"
1561	val = fgetKeyNam_s1(tname, keyn, ky, lerr=lerr) !--- "ky" and "tname"
1562	IF( lerr ) val = fgetKeyNam_s1(tnam, keyn, ky, lerr=lerr) !--- "ky" and "tnam"
1563	ELSE
1564	IF( .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0 !=== KEY FROM "tracers"
1565	IF(.NOT.lerr) THEN
1566	val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr) !--- "ky" and "tname"
1567	IF(lerr) val = fgetKeyNam_s1(tnam, keyn, tracers%keys, lerr=lerr) !--- "ky" and "tnam"
1568	END IF
1569	IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0 !=== KEY FROM "isotope"
1570	IF(.NOT.lerr) THEN
1571	val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr) !--- "ky" and "tname"
1572	IF(lerr) val = fgetKeyNam_s1(tnam, keyn, isotope%keys, lerr=lerr) !--- "ky" and "tnam"
1573	END IF
1574	END IF
1575	END FUNCTION getKeyByName_s1
1576	!==============================================================================================================================
1577	LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
1578	CHARACTER(LEN=*), INTENT(IN) :: keyn
1579	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1580	CHARACTER(LEN=*), INTENT(IN) :: tname
1581	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1582	!------------------------------------------------------------------------------------------------------------------------------
1583	CHARACTER(LEN=maxlen) :: sval
1584	lerr = getKeyByName_s1(keyn, sval, tname, ky)
1585	IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
1586	lerr = strParse(sval, ',', val)
1587	END FUNCTION getKeyByName_s1m
1588	!==============================================================================================================================
1589	LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
1590	CHARACTER(LEN=*), INTENT(IN) :: keyn
1591	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1592	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
1593	TYPE(keys_type), OPTIONAL, TARGET, INTENT(IN) :: ky(:)
1594	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1595	!------------------------------------------------------------------------------------------------------------------------------
1596	TYPE(keys_type), POINTER :: keys(:)
1597	LOGICAL :: lk, lt, li
1598	INTEGER :: iq, nq
1599
1600	!--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
1601	lk = PRESENT(ky)
1602	lt = .NOT.lk .AND. ALLOCATED(tracers); IF(lt) lt = SIZE(tracers) /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
1603	li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
1604
1605	!--- LINK "keys" TO THE RIGHT DATABASE
1606	IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
1607	IF(lk) keys => ky(:)
1608	IF(lt) keys => tracers(:)%keys
1609	IF(li) keys => isotope%keys(:)
1610
1611	!--- GET THE DATA
1612	nq = SIZE(tname)
1613	ALLOCATE(val(nq))
1614	lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
1615	IF(PRESENT(nam)) nam = tname(:)
1616
1617	END FUNCTION getKeyByName_sm
1618	!==============================================================================================================================
1619	LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
1620	CHARACTER(LEN=*), INTENT(IN) :: keyn
1621	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1622	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1623	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1624	!------------------------------------------------------------------------------------------------------------------------------
1625	! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
1626	IF(PRESENT(ky)) THEN !=== KEY FROM "ky"
1627	val = fgetKeys(keyn, ky, lerr=lerr)
1628	IF(PRESENT(nam)) nam = ky(:)%name
1629	ELSE
1630	IF( .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0 !=== KEY FROM "tracers"
1631	IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
1632	IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
1633	IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0 !=== KEY FROM "isotope"
1634	IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
1635	IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
1636	END IF
1637	END FUNCTION getKey_sm
1638	!==============================================================================================================================
1639	LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
1640	CHARACTER(LEN=*), INTENT(IN) :: keyn
1641	INTEGER, INTENT(OUT) :: val
1642	CHARACTER(LEN=*), INTENT(IN) :: tname
1643	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1644	!------------------------------------------------------------------------------------------------------------------------------
1645	CHARACTER(LEN=maxlen) :: sval
1646	INTEGER :: ierr
1647	lerr = getKeyByName_s1(keyn, sval, tname, ky)
1648	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
1649	READ(sval, *, IOSTAT=ierr) val
1650	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
1651	END FUNCTION getKeyByName_i1
1652	!==============================================================================================================================
1653	LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
1654	CHARACTER(LEN=*), INTENT(IN) :: keyn
1655	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1656	CHARACTER(LEN=*), INTENT(IN) :: tname
1657	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1658	!------------------------------------------------------------------------------------------------------------------------------
1659	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
1660	INTEGER :: ierr, iq, nq
1661	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
1662	nq = SIZE(sval); ALLOCATE(val(nq))
1663	lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
1664	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
1665	END FUNCTION getKeyByName_i1m
1666	!==============================================================================================================================
1667	LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
1668	CHARACTER(LEN=*), INTENT(IN) :: keyn
1669	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1670	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
1671	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1672	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1673	!------------------------------------------------------------------------------------------------------------------------------
1674	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
1675	INTEGER :: ierr, iq, nq
1676	IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
1677	nq = SIZE(sval); ALLOCATE(val(nq))
1678	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
1679	READ(sval(iq), *, IOSTAT=ierr) val(iq)
1680	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
1681	END DO
1682	IF(PRESENT(nam)) nam = names(:)
1683	END FUNCTION getKeyByName_im
1684	!==============================================================================================================================
1685	LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
1686	CHARACTER(LEN=*), INTENT(IN) :: keyn
1687	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1688	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1689	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1690	!------------------------------------------------------------------------------------------------------------------------------
1691	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
1692	INTEGER :: ierr, iq, nq
1693	IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
1694	nq = SIZE(sval); ALLOCATE(val(nq))
1695	DO iq = 1, nq
1696	READ(sval(iq), *, IOSTAT=ierr) val(iq)
1697	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
1698	END DO
1699	IF(PRESENT(nam)) nam = names
1700	END FUNCTION getKey_im
1701	!==============================================================================================================================
1702	LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
1703	CHARACTER(LEN=*), INTENT(IN) :: keyn
1704	REAL, INTENT(OUT) :: val
1705	CHARACTER(LEN=*), INTENT(IN) :: tname
1706	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1707	!------------------------------------------------------------------------------------------------------------------------------
1708	CHARACTER(LEN=maxlen) :: sval
1709	INTEGER :: ierr
1710	lerr = getKeyByName_s1(keyn, sval, tname, ky)
1711	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
1712	READ(sval, *, IOSTAT=ierr) val
1713	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
1714	END FUNCTION getKeyByName_r1
1715	!==============================================================================================================================
1716	LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
1717	CHARACTER(LEN=*), INTENT(IN) :: keyn
1718	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1719	CHARACTER(LEN=*), INTENT(IN) :: tname
1720	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1721	!------------------------------------------------------------------------------------------------------------------------------
1722	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
1723	INTEGER :: ierr, iq, nq
1724	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
1725	nq = SIZE(sval); ALLOCATE(val(nq))
1726	lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
1727	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
1728	END FUNCTION getKeyByName_r1m
1729	!==============================================================================================================================
1730	LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
1731	CHARACTER(LEN=*), INTENT(IN) :: keyn
1732	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1733	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
1734	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1735	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1736	!------------------------------------------------------------------------------------------------------------------------------
1737	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
1738	INTEGER :: ierr, iq, nq
1739	IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
1740	nq = SIZE(sval); ALLOCATE(val(nq))
1741	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
1742	READ(sval(iq), *, IOSTAT=ierr) val(iq)
1743	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
1744	END DO
1745	IF(PRESENT(nam)) nam = names
1746	END FUNCTION getKeyByName_rm
1747	!==============================================================================================================================
1748	LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
1749	CHARACTER(LEN=*), INTENT(IN) :: keyn
1750	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1751	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1752	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1753	!------------------------------------------------------------------------------------------------------------------------------
1754	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
1755	INTEGER :: ierr, iq, nq
1756	IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
1757	nq = SIZE(sval); ALLOCATE(val(nq))
1758	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
1759	READ(sval(iq), *, IOSTAT=ierr) val(iq)
1760	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
1761	END DO
1762	IF(PRESENT(nam)) nam = names
1763	END FUNCTION getKey_rm
1764	!==============================================================================================================================
1765	LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
1766	USE strings_mod, ONLY: str2bool
1767	CHARACTER(LEN=*), INTENT(IN) :: keyn
1768	LOGICAL, INTENT(OUT) :: val
1769	CHARACTER(LEN=*), INTENT(IN) :: tname
1770	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1771	!------------------------------------------------------------------------------------------------------------------------------
1772	CHARACTER(LEN=maxlen) :: sval
1773	lerr = getKeyByName_s1(keyn, sval, tname, ky)
1774	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
1775	val = str2bool(sval)
1776	END FUNCTION getKeyByName_l1
1777	!==============================================================================================================================
1778	LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
1779	USE strings_mod, ONLY: str2bool
1780	CHARACTER(LEN=*), INTENT(IN) :: keyn
1781	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1782	CHARACTER(LEN=*), INTENT(IN) :: tname
1783	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1784	!------------------------------------------------------------------------------------------------------------------------------
1785	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
1786	INTEGER :: iq, nq
1787	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
1788	nq = SIZE(sval); ALLOCATE(val(nq))
1789	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
1790	END FUNCTION getKeyByName_l1m
1791	!==============================================================================================================================
1792	LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
1793	USE strings_mod, ONLY: str2bool
1794	CHARACTER(LEN=*), INTENT(IN) :: keyn
1795	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1796	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
1797	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1798	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1799	!------------------------------------------------------------------------------------------------------------------------------
1800	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
1801	INTEGER :: iq, nq
1802	IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
1803	nq = SIZE(sval); ALLOCATE(val(nq))
1804	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
1805	END FUNCTION getKeyByName_lm
1806	!==============================================================================================================================
1807	LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
1808	USE strings_mod, ONLY: str2bool
1809	CHARACTER(LEN=*), INTENT(IN) :: keyn
1810	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1811	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1812	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
1813	!------------------------------------------------------------------------------------------------------------------------------
1814	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
1815	INTEGER :: iq, nq
1816	IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
1817	nq = SIZE(sval); ALLOCATE(val(nq))
1818	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
1819	END FUNCTION getKey_lm
1820	!==============================================================================================================================
1821
1822
1823	!==============================================================================================================================
1824	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
1825	!==============================================================================================================================
1826	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
1827	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
1828	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
1829	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
1830	!------------------------------------------------------------------------------------------------------------------------------
1831	TYPE(isot_type), ALLOCATABLE :: iso(:)
1832	INTEGER :: ix, nbIso
1833	IF(PRESENT( tracers_)) THEN; tracers = tracers_; ELSE; ALLOCATE( tracers(0)); END IF
1834	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
1835	IF(PRESENT(isotope_ )) THEN
1836	ix = strIdx(isotopes(:)%parent, isotope_%parent)
1837	IF(ix /= 0) THEN
1838	isotopes(ix) = isotope_
1839	ELSE
1840	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
1841	CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
1842	END IF
1843	END IF
1844	END SUBROUTINE setKeysDBase
1845	!==============================================================================================================================
1846	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
1847	TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
1848	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
1849	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
1850	!------------------------------------------------------------------------------------------------------------------------------
1851	INTEGER :: ix
1852	IF(PRESENT( tracers_)) THEN; tracers_ = tracers; ELSE; ALLOCATE( tracers_(0)); END IF
1853	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
1854	IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
1855	END SUBROUTINE getKeysDBase
1856	!==============================================================================================================================
1857
1858
1859	!==============================================================================================================================
1860	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
1861	!==============================================================================================================================
1862	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
1863	CHARACTER(LEN=*), INTENT(IN) :: s
1864	!------------------------------------------------------------------------------------------------------------------------------
1865	INTEGER :: ix, ip, ns
1866	out = s; ns = LEN_TRIM(s)
1867	IF(s == '' .OR. ns<=2) RETURN !--- Empty string or LEN(name)<=2: nothing to do
1868	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
1869	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
1870	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
1871	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
1872	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
1873	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
1874	END IF
1875	END FUNCTION delPhase
1876	!==============================================================================================================================
1877	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
1878	CHARACTER(LEN=*), INTENT(IN) :: s
1879	CHARACTER(LEN=1), INTENT(IN) :: pha
1880	!------------------------------------------------------------------------------------------------------------------------------
1881	INTEGER :: l, i
1882	out = s
1883	IF(s == '') RETURN !--- Empty string: nothing to do
1884	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
1885	l = LEN_TRIM(s)
1886	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
1887	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
1888	END FUNCTION addPhase_s1
1889	!==============================================================================================================================
1890	FUNCTION addPhase_sm(s,pha) RESULT(out)
1891	CHARACTER(LEN=*), INTENT(IN) :: s(:)
1892	CHARACTER(LEN=1), INTENT(IN) :: pha
1893	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
1894	!------------------------------------------------------------------------------------------------------------------------------
1895	INTEGER :: k
1896	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
1897	END FUNCTION addPhase_sm
1898	!==============================================================================================================================
1899	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
1900	CHARACTER(LEN=*), INTENT(IN) :: s
1901	INTEGER, INTENT(IN) :: ipha
1902	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1903	!------------------------------------------------------------------------------------------------------------------------------
1904	out = s
1905	IF(s == '') RETURN !--- Empty string: nothing to do
1906	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
1907	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
1908	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
1909	END FUNCTION addPhase_i1
1910	!==============================================================================================================================
1911	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
1912	CHARACTER(LEN=*), INTENT(IN) :: s(:)
1913	INTEGER, INTENT(IN) :: ipha
1914	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1915	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
1916	!------------------------------------------------------------------------------------------------------------------------------
1917	INTEGER :: k
1918	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
1919	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
1920	END FUNCTION addPhase_im
1921	!==============================================================================================================================
1922
1923
1924	!==============================================================================================================================
1925	!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
1926	!==============================================================================================================================
1927	SUBROUTINE addTracer_1(tname, keys, tracs)
1928	CHARACTER(LEN=*), INTENT(IN) :: tname
1929	TYPE(keys_type), INTENT(IN) :: keys
1930	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
1931	TYPE(trac_type), ALLOCATABLE :: tr(:)
1932	INTEGER :: nt, ix
1933	IF(ALLOCATED(tracs)) THEN
1934	nt = SIZE(tracs)
1935	ix = strIdx(tracs(:)%name, tname)
1936	CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
1937	CALL msg('Appending with tracer "' //TRIM(tname)//'"', modname, ix == 0)
1938	IF(ix == 0) THEN
1939	ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
1940	END IF
1941	ELSE
1942	CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
1943	ix = 1; ALLOCATE(tracs(1))
1944	END IF
1945	tracs(ix)%name = tname
1946	tracs(ix)%keys = keys
1947	END SUBROUTINE addTracer_1
1948	!==============================================================================================================================
1949	SUBROUTINE addTracer_1def(tname, keys)
1950	CHARACTER(LEN=*), INTENT(IN) :: tname
1951	TYPE(keys_type), INTENT(IN) :: keys
1952	CALL addTracer_1(tname, keys, tracers)
1953	END SUBROUTINE addTracer_1def
1954	!==============================================================================================================================
1955
1956
1957	!==============================================================================================================================
1958	LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
1959	CHARACTER(LEN=*), INTENT(IN) :: tname
1960	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
1961	TYPE(trac_type), ALLOCATABLE :: tr(:)
1962	INTEGER :: nt, ix
1963	lerr = .NOT.ALLOCATED(tracs)
1964	IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
1965	nt = SIZE(tracs)
1966	ix = strIdx(tracs(:)%name, tname)
1967	CALL msg('Removing tracer "' //TRIM(tname)//'"', modname, ix /= 0)
1968	CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
1969	IF(ix /= 0) THEN
1970	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)
1971	END IF
1972	END FUNCTION delTracer_1
1973	!==============================================================================================================================
1974	LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
1975	CHARACTER(LEN=*), INTENT(IN) :: tname
1976	lerr = delTracer(tname, tracers)
1977	END FUNCTION delTracer_1def
1978	!==============================================================================================================================
1979
1980
1981	!==============================================================================================================================
1982	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
1983	!==============================================================================================================================
1984	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
1985	CHARACTER(LEN=*), INTENT(IN) :: tname
1986	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1987	!------------------------------------------------------------------------------------------------------------------------------
1988	CHARACTER(LEN=maxlen) :: phase
1989	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
1990	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
1991	END FUNCTION getiPhase
1992	!==============================================================================================================================
1993	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
1994	CHARACTER(LEN=*), INTENT(IN) :: tname
1995	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1996	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
1997	!------------------------------------------------------------------------------------------------------------------------------
1998	INTEGER :: ip
1999	phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
2000	IF( PRESENT(phases)) ip = INDEX( phases, phase)
2001	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
2002	IF(ip == 0) phase = 'g'
2003	IF(PRESENT(iPhase)) iPhase = ip
2004	END FUNCTION getPhase
2005	!==============================================================================================================================
2006
2007
2008	!==============================================================================================================================
2009	!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
2010	!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
2011	!==============================================================================================================================
2012	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
2013	CHARACTER(LEN=*), INTENT(IN) :: oldName
2014	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2015	!------------------------------------------------------------------------------------------------------------------------------
2016	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
2017	INTEGER :: ix, ip, nt
2018	LOGICAL :: lerr
2019	newName = oldName
2020	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
2021	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
2022	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
2023	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
2024	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
2025	IF(nt == 1) THEN
2026	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
2027	ELSE
2028	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
2029	IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name
2030	IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name
2031	IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER
2032	END IF
2033	END FUNCTION old2newH2O_1
2034	!==============================================================================================================================
2035	FUNCTION old2newH2O_m(oldName) RESULT(newName)
2036	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
2037	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
2038	!------------------------------------------------------------------------------------------------------------------------------
2039	INTEGER :: i
2040	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
2041	END FUNCTION old2newH2O_m
2042	!==============================================================================================================================
2043
2044
2045	!==============================================================================================================================
2046	!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
2047	!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
2048	!==============================================================================================================================
2049	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
2050	CHARACTER(LEN=*), INTENT(IN) :: newName
2051	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
2052	!------------------------------------------------------------------------------------------------------------------------------
2053	INTEGER :: ix, ip
2054	CHARACTER(LEN=maxlen) :: var
2055	oldName = newName
2056	ip = getiPhase(newName) !--- Phase index
2057	IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous)
2058	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag
2059	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
2060	IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished
2061	oldName = 'H2O'
2062	IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip) !--- Add phase if needed
2063	IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix) !--- H2O isotope name
2064	IF(newName /= addPhase(var, ip)) &
2065	oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.) !--- Add the tag suffix
2066	IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix
2067	END FUNCTION new2oldH2O_1
2068	!==============================================================================================================================
2069	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
2070	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
2071	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
2072	!------------------------------------------------------------------------------------------------------------------------------
2073	INTEGER :: i
2074	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
2075	END FUNCTION new2oldH2O_m
2076	!==============================================================================================================================
2077
2078
2079	!==============================================================================================================================
2080	!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =======
2081	!==============================================================================================================================
2082	SUBROUTINE ancestor_1(t, out, tname, igen)
2083	TYPE(trac_type), INTENT(IN) :: t(:)
2084	CHARACTER(LEN=maxlen), INTENT(OUT) :: out
2085	CHARACTER(LEN=*), INTENT(IN) :: tname
2086	INTEGER, OPTIONAL, INTENT(IN) :: igen
2087	!------------------------------------------------------------------------------------------------------------------------------
2088	INTEGER :: ix
2089	CALL idxAncestor_1(t, ix, tname, igen)
2090	out = ''; IF(ix /= 0) out = t(ix)%name
2091	END SUBROUTINE ancestor_1
2092	!==============================================================================================================================
2093	SUBROUTINE ancestor_mt(t, out, tname, igen)
2094	TYPE(trac_type), INTENT(IN) :: t(:)
2095	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
2096	CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
2097	INTEGER, OPTIONAL, INTENT(IN) :: igen
2098	!------------------------------------------------------------------------------------------------------------------------------
2099	INTEGER :: ix(SIZE(tname))
2100	CALL idxAncestor_mt(t, ix, tname, igen)
2101	out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
2102	END SUBROUTINE ancestor_mt
2103	!==============================================================================================================================
2104	SUBROUTINE ancestor_m(t, out, igen)
2105	TYPE(trac_type), INTENT(IN) :: t(:)
2106	CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
2107	INTEGER, OPTIONAL, INTENT(IN) :: igen
2108	!------------------------------------------------------------------------------------------------------------------------------
2109	INTEGER :: ix(SIZE(t))
2110	CALL idxAncestor_m(t, ix, igen)
2111	out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
2112	END SUBROUTINE ancestor_m
2113	!==============================================================================================================================
2114
2115
2116	!==============================================================================================================================
2117	!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
2118	!==============================================================================================================================
2119	SUBROUTINE idxAncestor_1(t, idx, tname, igen)
2120	TYPE(trac_type), INTENT(IN) :: t(:)
2121	INTEGER, INTENT(OUT) :: idx
2122	CHARACTER(LEN=*), INTENT(IN) :: tname
2123	INTEGER, OPTIONAL, INTENT(IN) :: igen
2124	INTEGER :: ig
2125	ig = 0; IF(PRESENT(igen)) ig = igen
2126	idx = strIdx(t(:)%name, tname)
2127	IF(idx == 0) RETURN !--- Tracer not found
2128	IF(t(idx)%iGeneration <= ig) RETURN !--- Tracer has a lower generation number than asked generation 'igen"
2129	DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
2130	END SUBROUTINE idxAncestor_1
2131	!------------------------------------------------------------------------------------------------------------------------------
2132	SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
2133	TYPE(trac_type), INTENT(IN) :: t(:)
2134	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
2135	INTEGER, INTENT(OUT) :: idx(SIZE(tname))
2136	INTEGER, OPTIONAL, INTENT(IN) :: igen
2137	INTEGER :: ix
2138	DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
2139	END SUBROUTINE idxAncestor_mt
2140	!------------------------------------------------------------------------------------------------------------------------------
2141	SUBROUTINE idxAncestor_m(t, idx, igen)
2142	TYPE(trac_type), INTENT(IN) :: t(:)
2143	INTEGER, INTENT(OUT) :: idx(SIZE(t))
2144	INTEGER, OPTIONAL, INTENT(IN) :: igen
2145	INTEGER :: ix
2146	DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
2147	END SUBROUTINE idxAncestor_m
2148	!==============================================================================================================================
2149
2150
2151	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format