Context Navigation

readTracFiles_mod.f90 @ 4301

Last change on this file since 4301 was 4301, checked in by dcugnet, 20 months ago
for REPROBUS: simplify (and fix) the handling of exceptions for old HNO3 convention. cleaning + comments added in readTracFiles_mod.
File size: 103.3 KB

Line
1	MODULE readTracFiles_mod
2
3	USE strings_mod, ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce, strFind, strStack, strHead, &
4	test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr
5	USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
6
7	IMPLICIT NONE
8
9	PRIVATE
10
11	PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH
12	PUBLIC :: trac_type, readTracersFiles, setGeneration, indexUpdate !--- TRACERS DESCRIPTION ASSOCIATED TOOLS
13	PUBLIC :: keys_type, getKey, fGetKey, setDirectKeys, getKey_init !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes
14
15	PUBLIC :: addPhase, getiPhase, old_phases, phases_sep, nphases, & !--- FUNCTIONS RELATED TO THE PHASES
16	delPhase, getPhase, known_phases, phases_names !--- + ASSOCIATED VARIABLES
17
18	PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
19	PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc)
20
21	PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
22
23	!=== FOR ISOTOPES: GENERAL
24	PUBLIC :: isot_type, readIsotopesFile, initIsotopes !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
25
26	PUBLIC :: maxTableWidth
27	!------------------------------------------------------------------------------------------------------------------------------
28	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
29	CHARACTER(LEN=maxlen) :: name !--- Section name
30	TYPE(trac_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
31	END TYPE dataBase_type
32	!------------------------------------------------------------------------------------------------------------------------------
33	INTERFACE getKey
34	MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, &
35	getKeyByName_sm, getKeyByName_im, getKeyByName_rm
36	END INTERFACE getKey
37	!------------------------------------------------------------------------------------------------------------------------------
38	INTERFACE fGetKey; MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
39	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
40	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
41	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
42	INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
43	INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m; END INTERFACE ancestor
44	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
45	!------------------------------------------------------------------------------------------------------------------------------
46
47	!=== MAIN DATABASE: files sections descriptors
48	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
49
50	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
51	CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
52	CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlir' !--- Old phases for water (no separator)
53	CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr' !--- Known phases initials
54	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
55	CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
56	= ['gaseous', 'liquid ', 'solid ', 'cloud ']
57	CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator
58	LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists
59	LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation
60
61	!--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
62	CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ]
63	CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
64
65	!--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
66	CHARACTER(LEN=maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 ']
67	CHARACTER(LEN=maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot']
68
69	!=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
70	TYPE(trac_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
71	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
72
73	INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"
74	CHARACTER(LEN=maxlen) :: modname
75
76	CONTAINS
77
78	!==============================================================================================================================
79	!==============================================================================================================================
80	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
81	!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
82	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
83	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
84	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
85	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
86	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
87	!=== REMARKS:
88	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
89	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
90	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
91	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
92	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
93	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
94	!=== ABOUT THE KEYS:
95	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
96	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
97	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
98	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
99	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
100	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
101	!==============================================================================================================================
102	LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, tracs, lRepr) RESULT(lerr)
103	!------------------------------------------------------------------------------------------------------------------------------
104	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
105	INTEGER, OPTIONAL, INTENT(OUT) :: fTyp !--- Type of input file found
106	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
107	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr
108	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
109	CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname
110	INTEGER :: is, nsec, ierr, it, ntrac, ns, ip, ix, fType
111	LOGICAL, ALLOCATABLE :: ll(:), lGen3(:)
112	LOGICAL :: lRep
113	!------------------------------------------------------------------------------------------------------------------------------
114	lerr = .FALSE.
115	modname = 'readTracersFiles'
116	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
117	lRep=0; IF(PRESENT(lRepr)) lRep = lRepr
118
119	!--- Required sections + corresponding files names (new style single section case)
120	IF(test(strParse(type_trac, '\|', sections), lerr)) RETURN !--- Parse "type_trac" list
121
122	nsec = SIZE(sections, DIM=1)
123	ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
124
125	!--- LOOK AT AVAILABLE FILES
126	ll = .NOT.testFile(trac_files)
127	fType = 0
128	IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1 !--- OLD STYLE FILE
129	IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
130	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
131	IF(PRESENT(fTyp)) fTyp = fType
132	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
133	IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
134	END IF
135
136	!--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
137	IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN
138
139	!--- TELLS WHAT WAS IS ABOUT TO BE USED
140	IF (fmsg('No adequate tracers description file(s) found ; default values will be used', modname, fType==0)) RETURN
141	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
142	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
143	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
144
145	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
146	SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
147	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
148	CASE(1) !=== OLD FORMAT "traceur.def"
149	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
150	!--- OPEN THE "traceur.def" FILE
151	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
152
153	!--- GET THE TRACERS NUMBER
154	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
155	IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
156
157	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
158	ALLOCATE(tracs(ntrac))
159	DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number
160	READ(90,'(a)',IOSTAT=ierr) str
161	IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
162	IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
163	ll = strParse(str, ' ', s, n=ns)
164	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
165	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
166
167	!=== NAME OF THE TRACER
168	tname = old2newH2O(s(3), ip)
169	ix = strIdx(oldHNO3, s(3))
170	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
171	tracs(it)%name = tname !--- Set %name
172	tracs(it)%keys%name = tname !--- Copy tracers names in keys components
173
174	!=== NAME OF THE COMPONENT
175	cname = type_trac !--- Name of the model component
176	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
177	tracs(it)%component = cname !--- Set %component
178
179	!=== NAME OF THE PARENT
180	pname = tran0 !--- Default name: default transporting fluid (air)
181	IF(ns == 4) THEN
182	pname = old2newH2O(s(4))
183	ix = strIdx(oldHNO3, s(4))
184	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
185	END IF
186	tracs(it)%parent = pname !--- Set %parent
187
188	!=== PHASE AND ADVECTION SCHEMES NUMBERS
189	tracs(it)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase (default: "g"azeous)
190	tracs(it)%keys%key = ['hadv', 'vadv'] !--- Set %keys%key
191	tracs(it)%keys%val = s(1:2) !--- Set %keys%val
192	END DO
193	CLOSE(90)
194	CALL setGeneration(tracs) !--- Set %iGeneration and %gen0Name
195	WHERE(tracs%iGeneration == 2) tracs%type = 'tag' !--- Set %type: 'tracer' or 'tag'
196	IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN !--- Detect orphans and check phases
197	IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN !--- Detect repeated tracers
198	CALL sortTracers (tracs) !--- Sort the tracers
199	tracs(:)%keys%name = tracs(:)%name !--- Copy tracers names in keys components
200	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
201	CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
202	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
203	CASE(3); IF(test(feedDBase( trac_files , sections, modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE SECTION
204	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
205	END SELECT
206	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
207
208	IF(ALL([2,3] /= fType)) RETURN
209
210	IF(nsec == 1) THEN;
211	tracs = dBase(1)%trac
212	ELSE IF(tracs_merge) THEN
213	CALL msg('The multiple required sections will be MERGED.', modname)
214	IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
215	ELSE
216	CALL msg('The multiple required sections will be CUMULATED.', modname)
217	IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
218	END IF
219	CALL setDirectKeys(tracs) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
220	END FUNCTION readTracersFiles
221	!==============================================================================================================================
222
223	!==============================================================================================================================
224	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
225	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
226	! file and create the corresponding tracers set descriptors in the database "dBase":
227	! * dBase(id)%name : section name
228	! * dBase(id)%trac(:)%name : tracers names
229	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
230	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
231	!------------------------------------------------------------------------------------------------------------------------------
232	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
233	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
234	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling routine name
235	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
236	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
237	LOGICAL, ALLOCATABLE :: lTg(:) !--- Tagging tracers mask
238	CHARACTER(LEN=maxlen) :: fnm, snm
239	INTEGER :: idb, i
240	LOGICAL :: ll
241	!------------------------------------------------------------------------------------------------------------------------------
242	!=== READ THE REQUIRED SECTIONS
243	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
244	ALLOCATE(ixf(SUM(ndb)))
245	DO i=1, SIZE(fnames) !--- Set %name, %keys
246	IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
247	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
248	END DO
249	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
250	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
251	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
252	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
253	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
254	IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- EXPAND NAMES ; set %parent, %type, %component
255	CALL setGeneration (dBase(idb)%trac) !--- set %iGeneration, %genOName
256	IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES
257	IF(test(checkUnique (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
258	CALL expandPhases (dBase(idb)%trac) !--- EXPAND PHASES ; set %phase
259	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
260	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
261	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
262	END DO
263	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
264	END FUNCTION feedDBase
265	!------------------------------------------------------------------------------------------------------------------------------
266
267	!------------------------------------------------------------------------------------------------------------------------------
268	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
269	!------------------------------------------------------------------------------------------------------------------------------
270	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
271	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Pipe-separated sections list
272	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
273	!------------------------------------------------------------------------------------------------------------------------------
274	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
275	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
276	INTEGER, ALLOCATABLE :: ix(:)
277	INTEGER :: n0, idb, ndb, i, j
278	LOGICAL :: ll
279	!------------------------------------------------------------------------------------------------------------------------------
280	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
281	CALL readSections_all() !--- Read all the sections of file "fnam"
282	ndb= SIZE(dBase) !--- Current number of sections in the database
283	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
284	DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
285	END IF
286	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
287	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
288	IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
289	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
290
291	CONTAINS
292
293	!------------------------------------------------------------------------------------------------------------------------------
294	SUBROUTINE readSections_all()
295	!------------------------------------------------------------------------------------------------------------------------------
296	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
297	TYPE(trac_type), ALLOCATABLE :: tt(:)
298	TYPE(trac_type) :: tmp
299	CHARACTER(LEN=1024) :: str, str2
300	CHARACTER(LEN=maxlen) :: secn
301	INTEGER :: ierr, n
302	!------------------------------------------------------------------------------------------------------------------------------
303	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
304	OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
305	DO; str=''
306	DO
307	READ(90,'(a)', IOSTAT=ierr)str2 !--- Read a full line
308	str=TRIM(str)//' '//TRIM(str2) !--- Append "str" with the current line
309	n=LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
310	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
311	str = str(1:n-1) !--- Remove the "\" continuing line symbol
312	END DO
313	str = ADJUSTL(str) !--- Remove the front space
314	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
315	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
316	CALL removeComment(str) !--- Skip comments at the end of a line
317	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
318	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
319	ndb = SIZE(dBase) !--- Number of sections so far
320	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
321	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
322	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
323	ndb = ndb + 1 !--- Extend database
324	ALLOCATE(tdb(ndb))
325	tdb(1:ndb-1) = dBase
326	tdb(ndb)%name = secn
327	ALLOCATE(tdb(ndb)%trac(0))
328	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
329	ELSE !=== TRACER LINE
330	ll = strParse(str,' ', keys = s, vals = v, n = n) !--- Parse <key>=<val> pairs
331	tt = dBase(ndb)%trac(:)
332	tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n)) !--- Set %name and %keys
333	dBase(ndb)%trac = [tt(:), tmp]
334	DEALLOCATE(tt)
335	! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))]
336	END IF
337	END DO
338	CLOSE(90)
339
340	END SUBROUTINE readSections_all
341	!------------------------------------------------------------------------------------------------------------------------------
342
343	END FUNCTION readSections
344	!==============================================================================================================================
345
346
347	!==============================================================================================================================
348	SUBROUTINE addDefault(t, defName)
349	!------------------------------------------------------------------------------------------------------------------------------
350	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
351	!------------------------------------------------------------------------------------------------------------------------------
352	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
353	CHARACTER(LEN=*), INTENT(IN) :: defName
354	INTEGER :: jd, it, k
355	TYPE(keys_type), POINTER :: ky
356	TYPE(trac_type), ALLOCATABLE :: tt(:)
357	jd = strIdx(t(:)%name, defName)
358	IF(jd == 0) RETURN
359	ky => t(jd)%keys
360	DO k = 1, SIZE(ky%key) !--- Loop on the keys of the tracer named "defName"
361	! CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys) !--- Add key to all the tracers (no overwriting)
362	DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys); END DO
363	END DO
364	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
365	END SUBROUTINE addDefault
366	!==============================================================================================================================
367
368	!==============================================================================================================================
369	SUBROUTINE subDefault(t, defName, lSubLocal)
370	!------------------------------------------------------------------------------------------------------------------------------
371	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
372	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
373	!------------------------------------------------------------------------------------------------------------------------------
374	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
375	CHARACTER(LEN=*), INTENT(IN) :: defName
376	LOGICAL, INTENT(IN) :: lSubLocal
377	INTEGER :: i0, it, ik
378	TYPE(keys_type), POINTER :: k0, ky
379	TYPE(trac_type), ALLOCATABLE :: tt(:)
380	i0 = strIdx(t(:)%name, defName)
381	IF(i0 == 0) RETURN
382	k0 => t(i0)%keys
383	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
384	ky => t(it)%keys
385
386	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
387	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
388
389	IF(.NOT.lSubLocal) CYCLE
390	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
391	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
392	END DO
393	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
394
395	END SUBROUTINE subDefault
396	!==============================================================================================================================
397
398
399	!==============================================================================================================================
400	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
401	!------------------------------------------------------------------------------------------------------------------------------
402	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
403	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
404	! * Default values are provided for these keys because they are necessary.
405	!------------------------------------------------------------------------------------------------------------------------------
406	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
407	CHARACTER(LEN=*), INTENT(IN) :: sname
408	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname
409	TYPE(trac_type), ALLOCATABLE :: ttr(:)
410	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
411	CHARACTER(LEN=maxlen) :: msg1, modname
412	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
413	LOGICAL :: ll
414	modname = 'expandSection'
415	lerr = .FALSE.
416	nt = SIZE(tr)
417	nq = 0
418	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
419	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
420	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
421	!--- Extract useful keys: parent name, type, component name
422	tr(it)%parent = fgetKey(it, 'parent', tr(:)%keys, tran0 )
423	tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer')
424	tr(it)%component = sname
425
426	!--- Determine the number of tracers and parents ; coherence checking
427	ll = strCount(tr(it)%name, ',', ntr)
428	ll = strCount(tr(it)%parent, ',', npr)
429
430	!--- Tagging tracers only can have multiple parents
431	IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
432	msg1 = 'Check section "'//TRIM(sname)//'"'
433	IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
434	CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
435	END IF
436	nq = nq + ntr*npr
437	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
438	END DO
439	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
440	CALL delKey(['parent','type '], tr)
441
442	ALLOCATE(ttr(nq))
443	iq = 1
444	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
445	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
446	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
447	ll = strParse(tr(it)%name, ',', ta, n=ntr) !--- Number of tracers
448	ll = strParse(tr(it)%parent, ',', pa, n=npr) !--- Number of parents
449	DO ipr=1,npr !--- Loop on parents list elts
450	DO itr=1,ntr !--- Loop on tracers list elts
451	i = iq+itr-1+(ipr-1)*ntr
452	ttr(i)%name = TRIM(ta(itr))
453	ttr(i)%parent = TRIM(pa(ipr))
454	ttr(i)%keys%name = ta(itr)
455	ttr(i)%keys%key = tr(it)%keys%key
456	ttr(i)%keys%val = tr(it)%keys%val
457	! ttr(i)%keys = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
458	END DO
459	END DO
460	ttr(iq:iq+ntr*npr-1)%type = tr(it)%type !--- Duplicating type
461	ttr(iq:iq+ntr*npr-1)%component = tr(it)%component !--- Duplicating type
462	iq = iq + ntr*npr
463	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
464	END DO
465	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
466	DEALLOCATE(ta,pa)
467	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
468
469	END FUNCTION expandSection
470	!==============================================================================================================================
471
472	!==============================================================================================================================
473	SUBROUTINE setGeneration(tr)
474	!------------------------------------------------------------------------------------------------------------------------------
475	! Purpose: Determine, for each tracer of "tr(:)":
476	! * %iGeneration: the generation number
477	! * %gen0Name: the generation 0 ancestor name
478	!------------------------------------------------------------------------------------------------------------------------------
479	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
480	INTEGER :: iq, nq, ig
481	LOGICAL, ALLOCATABLE :: lg(:)
482	CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:)
483	!------------------------------------------------------------------------------------------------------------------------------
484	tr(:)%iGeneration = -1 !--- error if -1
485	nq = SIZE(tr, DIM=1) !--- Number of tracers lines
486	lg = tr(:)%parent == tran0 !--- Flag for generation 0 tracers
487	WHERE(lg) tr(:)%iGeneration = 0 !--- Generation 0 tracers
488
489	!=== Determine generation for each tracer
490	ig=-1; prn = [tran0]
491	DO !--- Update current generation flag
492	IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)
493	lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)] !--- Current generation tracers flag
494	IF( ALL( .NOT. lg ) ) EXIT !--- Empty current generation
495	ig = ig+1; WHERE(lg) tr(:)%iGeneration = ig
496	END DO
497	tr(:)%gen0Name = ancestor(tr) !--- First generation ancestor name
498
499	END SUBROUTINE setGeneration
500	!==============================================================================================================================
501
502	!==============================================================================================================================
503	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
504	!------------------------------------------------------------------------------------------------------------------------------
505	! Purpose:
506	! * check for orphan tracers (without known parent)
507	! * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
508	!------------------------------------------------------------------------------------------------------------------------------
509	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
510	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
511	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
512	CHARACTER(LEN=maxlen) :: mesg
513	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
514	CHARACTER(LEN=1) :: p
515	INTEGER :: ip, np, iq, nq
516	!------------------------------------------------------------------------------------------------------------------------------
517	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
518	mesg = 'Check section "'//TRIM(sname)//'"'
519	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
520
521	!=== CHECK FOR ORPHAN TRACERS
522	IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
523
524	!=== CHECK PHASES
525	DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE !--- Generation O only is checked
526	pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases
527	np = LEN_TRIM(pha); bp(iq)=' '
528	DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
529	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
530	END DO
531	lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
532	END FUNCTION checkTracers
533	!==============================================================================================================================
534
535	!==============================================================================================================================
536	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
537	!------------------------------------------------------------------------------------------------------------------------------
538	! Purpose: Make sure that tracers are not repeated.
539	!------------------------------------------------------------------------------------------------------------------------------
540	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
541	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
542	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
543	!------------------------------------------------------------------------------------------------------------------------------
544	INTEGER :: ip, np, iq, nq, k
545	LOGICAL, ALLOCATABLE :: ll(:)
546	CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
547	CHARACTER(LEN=1) :: p
548	!------------------------------------------------------------------------------------------------------------------------------
549	mesg = 'Check section "'//TRIM(sname)//'"'
550	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
551	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
552	tdup(:) = ''
553	DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE !--- Tags can be repeated
554	tnam = TRIM(tr(iq)%name)
555	ll = tr(:)%name==TRIM(tnam) !--- Mask for current tracer name
556	IF(COUNT(ll)==1 ) CYCLE !--- Tracer is not repeated
557	IF(tr(iq)%iGeneration>0) THEN
558	tdup(iq) = tnam !--- gen>0: MUST be unique
559	ELSE
560	DO ip=1,nphases; p=known_phases(ip:ip) !--- Loop on known phases
561	!--- Number of appearances of the current tracer with known phase "p"
562	np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
563	IF(np <=1) CYCLE
564	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
565	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
566	END DO
567	END IF
568	IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
569	END DO
570	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
571	END FUNCTION checkUnique
572	!==============================================================================================================================
573
574	!==============================================================================================================================
575	SUBROUTINE expandPhases(tr)
576	!------------------------------------------------------------------------------------------------------------------------------
577	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
578	!------------------------------------------------------------------------------------------------------------------------------
579	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
580	!------------------------------------------------------------------------------------------------------------------------------
581	TYPE(trac_type), ALLOCATABLE :: ttr(:)
582	INTEGER, ALLOCATABLE :: i0(:)
583	CHARACTER(LEN=maxlen) :: nam, pha, trn
584	CHARACTER(LEN=1) :: p
585	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
586	LOGICAL :: lTag, lExt
587	!------------------------------------------------------------------------------------------------------------------------------
588	nq = SIZE(tr, DIM=1)
589	nt = 0
590	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
591	IF(tr(iq)%iGeneration /= 0) CYCLE !--- Only deal with generation 0 tracers
592	nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0) !--- Number of childs of tr(iq)
593	tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys) !--- Phases list of tr(iq)
594	np = LEN_TRIM(tr(iq)%phase) !--- Number of phases of tr(iq)
595	nt = nt + (1+nc) * np !--- Number of tracers after expansion
596	END DO
597	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
598	it = 1 !--- Current "ttr(:)" index
599	DO iq = 1, nq !--- Loop on "tr(:)" indexes
600	lTag = tr(iq)%type=='tag' !--- Current tracer is a tag
601	i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n) !--- Indexes of first generation ancestor copies
602	np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1) !--- Number of phases for current tracer tr(iq)
603	lExt = np>1 !--- Phase suffix only required if phases number is > 1
604	IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0 !--- No phase suffix for generation 0 tags
605	DO i=1,n !=== LOOP ON GENERATION 0 ANCESTORS
606	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
607	IF(tr(iq)%iGeneration==0) jq=iq !--- Generation 0: count the current tracer phases only
608	pha = tr(jq)%phase !--- Phases list for tr(jq)
609	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
610	p = pha(ip:ip)
611	trn = TRIM(tr(iq)%name); nam = trn !--- Tracer name (regular case)
612	IF(lTag) nam = TRIM(tr(iq)%parent) !--- Parent name (tagging case)
613	IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed
614	IF(lTag) nam = TRIM(nam)//'_'//TRIM(trn) !--- <parent>_<name> for tags
615	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
616	ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix
617	ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor
618	ttr(it)%phase = p !--- Single phase entry
619	IF(lExt .AND. tr(iq)%iGeneration>0) THEN
620	ttr(it)%parent = addPhase(ttr(it)%parent, p)
621	ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
622	END IF
623	it = it+1
624	END DO
625	IF(tr(iq)%iGeneration==0) EXIT !--- Break phase loop for gen 0
626	END DO
627	END DO
628	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
629	CALL delKey(['phases'],tr) !--- Remove few keys entries
630
631	END SUBROUTINE expandPhases
632	!==============================================================================================================================
633
634	!==============================================================================================================================
635	SUBROUTINE sortTracers(tr)
636	!------------------------------------------------------------------------------------------------------------------------------
637	! Purpose: Sort tracers:
638	! * Put water at the beginning of the vector, in the "known_phases" order.
639	! * lGrowGen == T: in ascending generations numbers.
640	! * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
641	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
642	!------------------------------------------------------------------------------------------------------------------------------
643	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
644	!------------------------------------------------------------------------------------------------------------------------------
645	TYPE(trac_type), ALLOCATABLE :: tr2(:)
646	INTEGER, ALLOCATABLE :: iy(:), iz(:)
647	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
648	INTEGER :: it
649	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
650	!------------------------------------------------------------------------------------------------------------------------------
651	nq = SIZE(tr)
652	DO ip = nphases, 1, -1
653	iq = strIdx(tr(:)%name, addPhase('H2O', ip))
654	IF(iq == 0) CYCLE
655	tr2 = tr(:)
656	tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
657	END DO
658	IF(lSortByGen) THEN
659	iq = 1
660	ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations
661	DO ig = 0, ng !--- Loop on generations
662	iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig) !--- Generation ig tracers indexes
663	n = SIZE(iy)
664	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
665	iq = iq + n
666	END DO
667	ELSE
668	iq = 1
669	DO jq = 1, nq !--- Loop on generation 0 tracers
670	IF(tr(jq)%iGeneration /= 0) CYCLE !--- Skip generations /= 0
671	ix(iq) = jq !--- Generation 0 ancestor index first
672	iq = iq + 1 !--- Next "iq" for next generations tracers
673	iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name)) !--- Indexes of "tr(jq)" childs in "tr(:)"
674	ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations of the "tr(jq)" family
675	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
676	iz = find(tr(iy)%iGeneration, ig, n) !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
677	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
678	iq = iq + n
679	END DO
680	END DO
681	END IF
682	tr = tr(ix) !--- Reorder the tracers
683	END SUBROUTINE sortTracers
684	!==============================================================================================================================
685
686	!==============================================================================================================================
687	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
688	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
689	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
690	TYPE(trac_type), POINTER :: t1(:), t2(:)
691	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
692	INTEGER :: is, k1, k2, nk2, i1, i2, nt2
693	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
694	modname = 'mergeTracers'
695	lerr = .FALSE.
696	t1 => sections(1)%trac(:) !--- Alias: first tracers section
697	tr = t1
698	!----------------------------------------------------------------------------------------------------------------------------
699	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
700	!----------------------------------------------------------------------------------------------------------------------------
701	t2 => sections(is)%trac(:) !--- Alias: current tracers section
702	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
703	ixct = strIdx(t1(:)%name, t2(:)%name) !--- Indexes of common tracers
704	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
705	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
706	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
707	CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
708	!--------------------------------------------------------------------------------------------------------------------------
709	DO i2=1,nt2; tnam = TRIM(t2(i2)%name) !=== LOOP ON COMMON TRACERS
710	!--------------------------------------------------------------------------------------------------------------------------
711	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
712
713	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
714	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
715
716	IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent /= t2(i2)%parent), lerr)) RETURN
717	IF(test(fmsg('Type' //TRIM(s1), modname, t1(i1)%type /= t2(i2)%type), lerr)) RETURN
718	IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
719
720	!=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
721	nk2 = SIZE(t2(i2)%keys%key(:)) !--- Keys number in current section
722	ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:)) !--- Common keys indexes
723
724	!=== APPEND NEW KEYS
725	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
726	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
727
728	!--- KEEP TRACK OF THE COMPONENTS NAMES
729	tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
730
731	!--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
732	DO k2=1,nk2
733	k1 = ixck(k2); IF(k1 == 0) CYCLE
734	IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
735	END DO
736	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values
737
738	!--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
739	CALL msg('Key(s)'//TRIM(s1), modname)
740	DO k2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
741	knam = t2(i2)%keys%key(k2) !--- Name of the current key
742	k1 = ixck(k2) !--- Corresponding index in t1(:)
743	IF(k1 == 0) CYCLE !--- New keys are skipped
744	v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2) !--- Key values in t1(:) and t2(:)
745	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
746	END DO
747	!------------------------------------------------------------------------------------------------------------------------
748	END DO
749	!--------------------------------------------------------------------------------------------------------------------------
750	END DO
751	CALL sortTracers(tr)
752
753	END FUNCTION mergeTracers
754	!==============================================================================================================================
755
756	!==============================================================================================================================
757	LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
758	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
759	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
760	TYPE(trac_type), POINTER :: t1(:), t2(:)
761	INTEGER, ALLOCATABLE :: nt(:)
762	CHARACTER(LEN=maxlen) :: tnam, tnam_new
763	INTEGER :: iq, nq, is, ns, nsec
764	lerr = .FALSE. !--- Can't fail ; kept to match "mergeTracer" interface.
765	nsec = SIZE(sections)
766	tr = [( sections(is)%trac(:) , is=1, nsec )] !--- Concatenated tracers vector
767	nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )] !--- Number of tracers in each section
768	!----------------------------------------------------------------------------------------------------------------------------
769	DO is=1, nsec !=== LOOP ON SECTIONS
770	!----------------------------------------------------------------------------------------------------------------------------
771	t1 => sections(is)%trac(:)
772	!--------------------------------------------------------------------------------------------------------------------------
773	DO iq=1, nt(is) !=== LOOP ON TRACERS
774	!--------------------------------------------------------------------------------------------------------------------------
775	tnam = TRIM(t1(iq)%name) !--- Original name
776	IF(COUNT(t1%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished
777	tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension
778	nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections
779	ns = nt(is) !--- Number of tracers in the current section
780	tr(iq + nq)%name = TRIM(tnam_new) !--- Modify tracer name
781	WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new !--- Modify parent name
782	!--------------------------------------------------------------------------------------------------------------------------
783	END DO
784	!----------------------------------------------------------------------------------------------------------------------------
785	END DO
786	!----------------------------------------------------------------------------------------------------------------------------
787	CALL sortTracers(tr)
788	END FUNCTION cumulTracers
789	!==============================================================================================================================
790
791	!==============================================================================================================================
792	SUBROUTINE setDirectKeys(tr)
793	TYPE(trac_type), INTENT(INOUT) :: tr(:)
794
795	!--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds
796	CALL indexUpdate(tr)
797
798	!--- Extract some direct-access keys
799	! DO iq = 1, SIZE(tr)
800	! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
801	! END DO
802	END SUBROUTINE setDirectKeys
803	!==============================================================================================================================
804
805	!==============================================================================================================================
806	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
807	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
808	INTEGER :: idb, iq, nq
809	INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
810	CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:)
811	TYPE(trac_type), POINTER :: tm(:)
812	lerr = .FALSE.
813	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
814	tm => dBase(idb)%trac
815	nq = SIZE(tm)
816	!--- BEWARE ! Can't use the "getKeyByName" functions yet.
817	! Names must first include the phases for tracers defined on multiple lines.
818	hadv = str2int([(fgetKey(iq, 'hadv', tm(:)%keys, '10'), iq=1, nq)])
819	vadv = str2int([(fgetKey(iq, 'vadv', tm(:)%keys, '10'), iq=1, nq)])
820	phas = [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
821	CALL msg(TRIM(message)//':', modname)
822	IF(ALL(tm(:)%parent == '')) THEN
823	IF(test(dispTable('iiiss', ['iq ','hadv ','vadv ','name ','phase '], cat(tm%name, phas), &
824	cat([(iq, iq=1, nq)], hadv, vadv), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
825	ELSE
826	IF(test(dispTable('iiissis', ['iq ','hadv ','vadv ','name ','parent','igen ','phase '], cat(tm%name, tm%parent, &
827	tm%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
828	END IF
829	END FUNCTION dispTraSection
830	!==============================================================================================================================
831
832
833	!==============================================================================================================================
834	!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
835	!==============================================================================================================================
836	FUNCTION aliasTracer(tname, t) RESULT(out)
837	TYPE(trac_type), POINTER :: out
838	CHARACTER(LEN=*), INTENT(IN) :: tname
839	TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
840	INTEGER :: it
841	it = strIdx(t(:)%name, tname)
842	out => NULL(); IF(it /= 0) out => t(it)
843	END FUNCTION aliasTracer
844	!==============================================================================================================================
845
846
847	!==============================================================================================================================
848	!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
849	!==============================================================================================================================
850	FUNCTION trSubset_Indx(trac,idx) RESULT(out)
851	TYPE(trac_type), ALLOCATABLE :: out(:)
852	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
853	INTEGER, INTENT(IN) :: idx(:)
854	out = trac(idx)
855	CALL indexUpdate(out)
856	END FUNCTION trSubset_Indx
857	!------------------------------------------------------------------------------------------------------------------------------
858	FUNCTION trSubset_Name(trac,nam) RESULT(out)
859	TYPE(trac_type), ALLOCATABLE :: out(:)
860	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
861	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
862	out = trac(strIdx(trac(:)%name, nam))
863	CALL indexUpdate(out)
864	END FUNCTION trSubset_Name
865	!==============================================================================================================================
866
867
868	!==============================================================================================================================
869	!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
870	!==============================================================================================================================
871	FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
872	TYPE(trac_type), ALLOCATABLE :: out(:)
873	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
874	CHARACTER(LEN=*), INTENT(IN) :: nam
875	out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
876	CALL indexUpdate(out)
877	END FUNCTION trSubset_gen0Name
878	!==============================================================================================================================
879
880
881	!==============================================================================================================================
882	!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
883	!==============================================================================================================================
884	SUBROUTINE indexUpdate(tr)
885	TYPE(trac_type), INTENT(INOUT) :: tr(:)
886	INTEGER :: iq, ig, ng, igen, ngen
887	INTEGER, ALLOCATABLE :: ix(:)
888	tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index
889	ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
890	DO iq = 1, SIZE(tr)
891	ig = tr(iq)%iGeneration
892	IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
893	ALLOCATE(tr(iq)%iqDescen(0))
894	ix = idxAncestor(tr, igen=ig) !--- Ancestor of generation "ng" for each tr
895	DO igen = ig+1, ngen
896	tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
897	tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
898	IF(igen == ig+1) tr(iq)%nqChilds=tr(iq)%nqDescen
899	END DO
900	END DO
901	END SUBROUTINE indexUpdate
902	!==============================================================================================================================
903
904
905	!==============================================================================================================================
906	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
907	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
908	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
909	!=== NOTES: ====
910	!=== * Most of the "isot" components have been defined in the calling routine (initIsotopes): ====
911	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
912	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
913	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
914	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
915	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
916	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
917	!==============================================================================================================================
918	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
919	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
920	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!)
921	INTEGER :: ik, is, it, idb, nk0, i, iis
922	INTEGER :: nk, ns, nt, ndb, nb0, i0
923	CHARACTER(LEN=maxlen), POINTER :: k(:), v(:), k0(:), v0(:)
924	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
925	CHARACTER(LEN=maxlen) :: val, modname
926	TYPE(keys_type), POINTER :: ky(:)
927	TYPE(trac_type), POINTER :: tt(:), t
928	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
929	LOGICAL, ALLOCATABLE :: liso(:)
930	modname = 'readIsotopesFile'
931
932	!--- THE INPUT FILE MUST BE PRESENT
933	IF(test(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, testFile(fnam)),lerr)) RETURN
934
935	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
936	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
937	IF(test(readSections(fnam,strStack(isot(:)%parent,'\|')),lerr)) RETURN !--- Read sections, one each parent tracer
938	ndb = SIZE(dBase, DIM=1) !--- Current database size
939	DO idb = nb0, ndb
940	iis = idb-nb0+1
941
942	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
943	CALL addKeysFromDef(dBase(idb)%trac, 'params')
944
945	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
946	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
947
948	tt => dBase(idb)%trac
949
950	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
951	DO it = 1, SIZE(dBase(idb)%trac)
952	t => dBase(idb)%trac(it)
953	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
954	IF(is == 0) CYCLE
955	liso = reduceExpr(t%keys%val, vals) !--- Reduce expressions (for substituted variables)
956	IF(test(ANY(liso), lerr)) RETURN !--- Some non-numerical elements were found
957	isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso)
958	isot(iis)%keys(is)%val = PACK( vals, MASK=.NOT.liso)
959	END DO
960
961	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
962	liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
963	IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
964	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
965	END DO
966
967	!--- CLEAN THE DATABASE ENTRIES
968	IF(nb0 == 1) THEN
969	DEALLOCATE(dBase); ALLOCATE(dBase(0))
970	ELSE
971	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
972	END IF
973
974	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
975	CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
976
977	lerr = dispIsotopes(isot, 'Isotopes parameters read from file "'//TRIM(fnam)//'"', modname)
978
979	END FUNCTION readIsotopesFile
980	!==============================================================================================================================
981
982
983	!==============================================================================================================================
984	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
985	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
986	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
987	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
988	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
989	!==============================================================================================================================
990	LOGICAL FUNCTION initIsotopes(trac, isot) RESULT(lerr)
991	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
992	TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
993	CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
994	CHARACTER(LEN=maxlen) :: iName
995	CHARACTER(LEN=1) :: ph !--- Phase
996	INTEGER :: nbIso, ic, ip, iq, it, iz
997	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
998	TYPE(trac_type), POINTER :: t(:), t1
999	TYPE(isot_type), POINTER :: i
1000	lerr = .FALSE.
1001
1002	t => trac
1003
1004	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
1005	p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
1006	CALL strReduce(p, nbIso)
1007	ALLOCATE(isot(nbIso))
1008
1009	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
1010
1011	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
1012	isot(:)%parent = p
1013	DO ic = 1, SIZE(p) !--- Loop on isotopes classes
1014	i => isot(ic)
1015	iname = i%parent !--- Current isotopes class name (parent tracer name)
1016
1017	!=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
1018	ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
1019	str = PACK(delPhase(t(:)%name), MASK = ll) !--- Effectively found isotopes of "iname"
1020	i%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
1021	ALLOCATE(i%keys(i%niso))
1022	FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
1023
1024	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
1025	ll = t(:)%type=='tag' .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
1026	i%zone = PACK(strTail(t(:)%name,'_'), MASK = ll) !--- Tagging zones names for isotopes category "iname"
1027	CALL strReduce(i%zone)
1028	i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname"
1029
1030	!=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
1031	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
1032	str = PACK(delPhase(t(:)%name), MASK=ll)
1033	CALL strReduce(str)
1034	i%ntiso = i%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntiso]
1035	ALLOCATE(i%trac(i%ntiso))
1036	FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
1037	FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
1038
1039	!=== Phases for tracer "iname"
1040	i%phase = ''
1041	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
1042	i%nphas = LEN_TRIM(i%phase) !--- Equal to "nqo" for water
1043
1044	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
1045	DO iq = 1, SIZE(t)
1046	t1 => trac(iq)
1047	IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname"
1048	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
1049	t1%iso_iName = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope idx in effective isotopes list
1050	t1%iso_iZone = strIdx(i%zone, strTail(t1%name,'_') ) !--- Current isotope zone idx in effective zones list
1051	t1%iso_iPhase = INDEX(i%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
1052	IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers
1053	END DO
1054
1055	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
1056	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
1057	i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], &
1058	[i%ntiso, i%nphas] )
1059	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
1060	i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
1061	[i%nzone, i%niso] )
1062	END DO
1063
1064	!=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
1065	lerr = readIsotopesFile('isotopes_params.def',isot)
1066
1067	END FUNCTION initIsotopes
1068	!==============================================================================================================================
1069
1070
1071	!==============================================================================================================================
1072	LOGICAL FUNCTION dispIsotopes(ides, message, modname) RESULT(lerr)
1073	TYPE(isot_type), INTENT(IN) :: ides(:) !--- Isotopes descriptor vector
1074	CHARACTER(LEN=*), INTENT(IN) :: message !--- Message to display
1075	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling subroutine name
1076	INTEGER :: ik, nk, ip, it, nt
1077	CHARACTER(LEN=maxlen) :: prf
1078	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
1079	CALL msg(TRIM(message)//':', modname)
1080	DO ip = 1, SIZE(ides) !--- Loop on parents tracers
1081	nk = SIZE(ides(ip)%keys(1)%key) !--- Same keys for each isotope
1082	nt = SIZE(ides(ip)%keys) !--- Number of isotopes
1083	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
1084	ALLOCATE(ttl(nk+2), val(nt,nk+1))
1085	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
1086	val(:,1) = ides(ip)%keys(:)%name !--- Values table 1st column: isotopes names
1087	DO ik = 1, nk
1088	DO it = 1, nt
1089	val(it,ik+1) = ides(ip)%keys(it)%val(ik) !--- Other columns: keys values
1090	END DO
1091	END DO
1092	IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
1093	cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
1094	DEALLOCATE(ttl, val)
1095	END DO
1096	END FUNCTION dispIsotopes
1097	!==============================================================================================================================
1098
1099
1100	!==============================================================================================================================
1101	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
1102	!==============================================================================================================================
1103	SUBROUTINE addKey_1(key, val, ky, lOverWrite)
1104	CHARACTER(LEN=*), INTENT(IN) :: key, val
1105	TYPE(keys_type), INTENT(INOUT) :: ky
1106	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1107	!------------------------------------------------------------------------------------------------------------------------------
1108	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1109	INTEGER :: iky, nky
1110	LOGICAL :: lo
1111	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
1112	iky = strIdx(ky%key,key)
1113	IF(iky == 0) THEN
1114	nky = SIZE(ky%key)
1115	IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
1116	ELSE IF(lo) THEN !--- Overwriting
1117	ky%key(iky) = key; ky%val(iky) = val
1118	END IF
1119	END SUBROUTINE addKey_1
1120	!==============================================================================================================================
1121	SUBROUTINE addKey_m(key, val, ky, lOverWrite)
1122	CHARACTER(LEN=*), INTENT(IN) :: key, val
1123	TYPE(keys_type), INTENT(INOUT) :: ky(:)
1124	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
1125	!------------------------------------------------------------------------------------------------------------------------------
1126	INTEGER :: itr
1127	LOGICAL :: lo
1128	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
1129	DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
1130	END SUBROUTINE addKey_m
1131	!==============================================================================================================================
1132
1133
1134	!==============================================================================================================================
1135	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
1136	!==============================================================================================================================
1137	SUBROUTINE addKeysFromDef(t, tr0)
1138	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
1139	CHARACTER(LEN=*), INTENT(IN) :: tr0
1140	!------------------------------------------------------------------------------------------------------------------------------
1141	CHARACTER(LEN=maxlen) :: val
1142	INTEGER :: ik, jd
1143	jd = strIdx(t%name, tr0)
1144	IF(jd == 0) RETURN
1145	DO ik = 1, SIZE(t(jd)%keys%key)
1146	CALL get_in(t(jd)%keys%key(ik), val, 'none')
1147	IF(val /= 'none') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
1148	END DO
1149	END SUBROUTINE addKeysFromDef
1150	!==============================================================================================================================
1151
1152
1153	!==============================================================================================================================
1154	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
1155	!==============================================================================================================================
1156	SUBROUTINE delKey_1(itr, keyn, ky)
1157	INTEGER, INTENT(IN) :: itr
1158	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1159	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1160	!------------------------------------------------------------------------------------------------------------------------------
1161	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
1162	LOGICAL, ALLOCATABLE :: ll(:)
1163	INTEGER :: iky
1164	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
1165	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
1166	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
1167	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
1168	END SUBROUTINE delKey_1
1169	!==============================================================================================================================
1170	SUBROUTINE delKey(keyn, ky)
1171	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1172	TYPE(trac_type), INTENT(INOUT) :: ky(:)
1173	!------------------------------------------------------------------------------------------------------------------------------
1174	INTEGER :: iky
1175	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
1176	END SUBROUTINE delKey
1177	!==============================================================================================================================
1178
1179
1180	!==============================================================================================================================
1181	!=== getKey ROUTINE INITIALIZATION (TO BE EMBEDDED SOMEWHERE) ================================================================
1182	!==============================================================================================================================
1183	SUBROUTINE getKey_init(tracers_, isotopes_)
1184	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
1185	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
1186	IF(PRESENT( tracers_)) tracers = tracers_
1187	IF(PRESENT(isotopes_)) isotopes = isotopes_
1188	END SUBROUTINE getKey_init
1189
1190
1191	!==============================================================================================================================
1192	!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
1193	!==============================================================================================================================
1194	CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
1195	INTEGER, INTENT(IN) :: itr
1196	CHARACTER(LEN=*), INTENT(IN) :: keyn
1197	TYPE(keys_type), INTENT(IN) :: ky(:)
1198	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1199	!------------------------------------------------------------------------------------------------------------------------------
1200	INTEGER :: iky
1201	iky = 0; IF(itr > 0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
1202	val = ''; IF(iky /= 0) val = ky(itr)%val(iky) !--- Key was found
1203	IF(PRESENT(def_val) .AND. iky == 0) val = def_val !--- Default value from arguments
1204	END FUNCTION fgetKeyByIndex_s1
1205	!==============================================================================================================================
1206	CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
1207	CHARACTER(LEN=*), INTENT(IN) :: tname, keyn
1208	TYPE(keys_type), INTENT(IN) :: ky(:)
1209	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1210	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
1211	!------------------------------------------------------------------------------------------------------------------------------
1212	INTEGER :: iky, itr
1213	val = ''; iky = 0
1214	itr = strIdx(ky(:)%name, tname) !--- Get the index of the wanted tracer
1215	IF(PRESENT(lerr)) lerr = itr==0; IF(itr == 0) RETURN
1216	IF(itr > 0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
1217	IF(iky /= 0) val = ky(itr)%val(iky) !--- Key was found
1218	IF(PRESENT(def_val) .AND. iky == 0) val = def_val !--- Default value from arguments
1219	END FUNCTION fgetKeyByName_s1
1220	!==============================================================================================================================
1221
1222
1223	!==============================================================================================================================
1224	!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE ==============
1225	!========== The key "keyn" is searched in: 1) "ky(:)%name" (if given) ==============
1226	!========== 2) "tracers(:)%name" ==============
1227	!========== 3) "isotope%keys(:)%name" ==============
1228	!========== for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
1229	!========== The type of the returned value(s) can be string, integer or real, scalar or vector ==============
1230	!==============================================================================================================================
1231	LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
1232	CHARACTER(LEN=*), INTENT(IN) :: keyn
1233	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
1234	CHARACTER(LEN=*), INTENT(IN) :: tname
1235	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1236	!------------------------------------------------------------------------------------------------------------------------------
1237	CHARACTER(LEN=maxlen) :: tnam
1238	INTEGER, ALLOCATABLE :: is(:)
1239	INTEGER :: i, itr
1240	tnam = delPhase(strHead(tname,'_',.FALSE.)) !--- Remove tag and phase
1241	IF(PRESENT(ky)) THEN
1242	val = fgetKeyByName_s1(tname, keyn, ky, lerr=lerr) !--- "ky" and "tname"
1243	IF(val /= '' .OR. lerr) RETURN
1244	val = fgetKeyByName_s1(tnam, keyn, ky, lerr=lerr) !--- "ky" and "tnam"
1245	ELSE
1246	IF(.NOT.ALLOCATED(tracers)) RETURN
1247	val = fgetKeyByName_s1(tname, keyn, tracers(:)%keys, lerr=lerr) !--- "tracers" and "tname"
1248	IF(val /= ''.AND..NOT.lerr) RETURN
1249	IF(.NOT.ALLOCATED(isotopes)) RETURN
1250	IF(SIZE(isotopes) == 0) RETURN
1251	!--- Search the "is" isotopes class index of the isotope named "tnam"
1252	is = find([(ANY(isotopes(i)%keys(:)%name == tnam), i=1, SIZE(isotopes))])
1253	IF(test(SIZE(is) == 0,lerr)) RETURN
1254	val = fgetKeyByName_s1(tname, keyn, isotopes(is(1))%keys(:),lerr=lerr)!--- "isotopes" and "tnam"
1255	END IF
1256	END FUNCTION getKeyByName_s1
1257	!==============================================================================================================================
1258	LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky) RESULT(lerr)
1259	CHARACTER(LEN=*), INTENT(IN) :: keyn
1260	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
1261	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1262	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1263	!------------------------------------------------------------------------------------------------------------------------------
1264	TYPE(keys_type), POINTER :: k(:)
1265	CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
1266	INTEGER :: iq, nq
1267	IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
1268	IF(PRESENT(ky )) nq = SIZE(ky%name)
1269	IF(PRESENT(tname)) nq = SIZE( tname)
1270	ALLOCATE(val(nq))
1271	IF(PRESENT(tname)) THEN
1272	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), ky), iq=1, nq)])
1273	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq) ), iq=1, nq)])
1274	ELSE; lerr = ANY([(getKeyByName_s1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
1275	END IF
1276	END FUNCTION getKeyByName_sm
1277	!==============================================================================================================================
1278	LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
1279	CHARACTER(LEN=*), INTENT(IN) :: keyn
1280	INTEGER, INTENT(OUT) :: val
1281	CHARACTER(LEN=*), INTENT(IN) :: tname
1282	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1283	!------------------------------------------------------------------------------------------------------------------------------
1284	CHARACTER(LEN=maxlen) :: sval
1285	INTEGER :: ierr
1286	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
1287	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
1288	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
1289	READ(sval, *, IOSTAT=ierr) val
1290	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
1291	END FUNCTION getKeyByName_i1
1292	!==============================================================================================================================
1293	LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
1294	CHARACTER(LEN=*), INTENT(IN) :: keyn
1295	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1296	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1297	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1298	!------------------------------------------------------------------------------------------------------------------------------
1299	TYPE(keys_type), POINTER :: k(:)
1300	CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
1301	INTEGER :: iq, nq
1302	IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
1303	IF(PRESENT(ky )) nq = SIZE(ky%name)
1304	IF(PRESENT(tname)) nq = SIZE( tname)
1305	ALLOCATE(val(nq))
1306	IF(PRESENT(tname)) THEN
1307	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq), ky), iq=1, nq)])
1308	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq) ), iq=1, nq)])
1309	ELSE; lerr = ANY([(getKeyByName_i1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
1310	END IF
1311	END FUNCTION getKeyByName_im
1312	!==============================================================================================================================
1313	LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
1314	CHARACTER(LEN=*), INTENT(IN) :: keyn
1315	REAL, INTENT(OUT) :: val
1316	CHARACTER(LEN=*), INTENT(IN) :: tname
1317	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1318	!------------------------------------------------------------------------------------------------------------------------------
1319	CHARACTER(LEN=maxlen) :: sval
1320	INTEGER :: ierr
1321	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
1322	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
1323	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
1324	READ(sval, *, IOSTAT=ierr) val
1325	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
1326	END FUNCTION getKeyByName_r1
1327	!==============================================================================================================================
1328	LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky) RESULT(lerr)
1329	CHARACTER(LEN=*), INTENT(IN) :: keyn
1330	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1331	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1332	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
1333	!------------------------------------------------------------------------------------------------------------------------------
1334	TYPE(keys_type), POINTER :: k(:)
1335	CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
1336	INTEGER :: iq, nq
1337	IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
1338	IF(PRESENT(ky )) nq = SIZE(ky%name)
1339	IF(PRESENT(tname)) nq = SIZE( tname)
1340	ALLOCATE(val(nq))
1341	IF(PRESENT(tname)) THEN
1342	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq), ky), iq=1, nq)])
1343	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq) ), iq=1, nq)])
1344	ELSE; lerr = ANY([(getKeyByName_r1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
1345	END IF
1346	END FUNCTION getKeyByName_rm
1347	!==============================================================================================================================
1348
1349
1350	!==============================================================================================================================
1351	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
1352	!==============================================================================================================================
1353	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
1354	CHARACTER(LEN=*), INTENT(IN) :: s
1355	!------------------------------------------------------------------------------------------------------------------------------
1356	INTEGER :: ix, ip, ns
1357	out = s; ns = LEN_TRIM(s)
1358	IF(s == '') RETURN !--- Empty string: nothing to do
1359	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
1360	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
1361	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
1362	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
1363	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
1364	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
1365	END IF
1366	END FUNCTION delPhase
1367	!==============================================================================================================================
1368	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
1369	CHARACTER(LEN=*), INTENT(IN) :: s
1370	CHARACTER(LEN=1), INTENT(IN) :: pha
1371	!------------------------------------------------------------------------------------------------------------------------------
1372	INTEGER :: l, i
1373	out = s
1374	IF(s == '') RETURN !--- Empty string: nothing to do
1375	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
1376	l = LEN_TRIM(s)
1377	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
1378	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
1379	END FUNCTION addPhase_s1
1380	!==============================================================================================================================
1381	FUNCTION addPhase_sm(s,pha) RESULT(out)
1382	CHARACTER(LEN=*), INTENT(IN) :: s(:)
1383	CHARACTER(LEN=1), INTENT(IN) :: pha
1384	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
1385	!------------------------------------------------------------------------------------------------------------------------------
1386	INTEGER :: k
1387	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
1388	END FUNCTION addPhase_sm
1389	!==============================================================================================================================
1390	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
1391	CHARACTER(LEN=*), INTENT(IN) :: s
1392	INTEGER, INTENT(IN) :: ipha
1393	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1394	!------------------------------------------------------------------------------------------------------------------------------
1395	out = s
1396	IF(s == '') RETURN !--- Empty string: nothing to do
1397	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
1398	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
1399	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
1400	END FUNCTION addPhase_i1
1401	!==============================================================================================================================
1402	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
1403	CHARACTER(LEN=*), INTENT(IN) :: s(:)
1404	INTEGER, INTENT(IN) :: ipha
1405	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1406	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
1407	!------------------------------------------------------------------------------------------------------------------------------
1408	INTEGER :: k
1409	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
1410	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
1411	END FUNCTION addPhase_im
1412	!==============================================================================================================================
1413
1414
1415	!==============================================================================================================================
1416	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
1417	!==============================================================================================================================
1418	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
1419	CHARACTER(LEN=*), INTENT(IN) :: tname
1420	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1421	!------------------------------------------------------------------------------------------------------------------------------
1422	CHARACTER(LEN=maxlen) :: phase
1423	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
1424	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
1425	END FUNCTION getiPhase
1426	!==============================================================================================================================
1427	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
1428	CHARACTER(LEN=*), INTENT(IN) :: tname
1429	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
1430	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
1431	!------------------------------------------------------------------------------------------------------------------------------
1432	INTEGER :: ip
1433	phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
1434	IF( PRESENT(phases)) ip = INDEX( phases, phase)
1435	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
1436	IF(ip == 0) phase = 'g'
1437	IF(PRESENT(iPhase)) iPhase = ip
1438	END FUNCTION getPhase
1439	!==============================================================================================================================
1440
1441
1442	!==============================================================================================================================
1443	!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
1444	!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
1445	!==============================================================================================================================
1446	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
1447	CHARACTER(LEN=*), INTENT(IN) :: oldName
1448	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
1449	!------------------------------------------------------------------------------------------------------------------------------
1450	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
1451	INTEGER :: ix, ip, nt
1452	LOGICAL :: lerr
1453	newName = oldName
1454	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
1455	lerr = strParse(oldName, '_', tmp, n=nt) !--- Parsing: 1 up to 3 elements.
1456	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
1457	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
1458	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
1459	IF(nt == 1) THEN
1460	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
1461	ELSE
1462	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
1463	IF(ix /= 0) tmp(2) = newH2OIso(ix) !--- Move to new isotope name
1464	IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip) !--- Add phase to isotope name
1465	newName = TRIM(strStack(tmp(2:nt), '_')) !=== WATER ISOTOPE OR TAGGING TRACER
1466	END IF
1467	END FUNCTION old2newH2O_1
1468	!==============================================================================================================================
1469	FUNCTION old2newH2O_m(oldName) RESULT(newName)
1470	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
1471	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
1472	!------------------------------------------------------------------------------------------------------------------------------
1473	INTEGER :: i
1474	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
1475	END FUNCTION old2newH2O_m
1476	!==============================================================================================================================
1477
1478
1479	!==============================================================================================================================
1480	!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
1481	!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
1482	!==============================================================================================================================
1483	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
1484	CHARACTER(LEN=*), INTENT(IN) :: newName
1485	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
1486	!------------------------------------------------------------------------------------------------------------------------------
1487	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
1488	INTEGER :: ix, ip
1489	CHARACTER(LEN=maxlen) :: var
1490	oldName = newName
1491	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
1492	ip = getiPhase(newName) !--- Phase index
1493	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
1494	ix = strIdx(newH2OIso, newName) !--- Index in the known H2O isotopes list
1495	IF(ix /= 0) oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITHOUT PHASE
1496	IF(ix /= 0 .OR. ip == 0) RETURN
1497	oldName = 'H2O'//old_phases(ip:ip)
1498	IF(newName == addPhase('H2O', ip)) RETURN !=== WATER WITH PHASE
1499	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Head variable name (no phase)
1500	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
1501	IF(ix == 0) RETURN !=== H2O[vli]_<var> (<var> /= H2O isotope)
1502	oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITH PHASE
1503	var = addPhase(var, ip) !--- Head variable with phase
1504	IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var)) !=== WATER ISOTOPIC TAGGING TRACER
1505	END FUNCTION new2oldH2O_1
1506	!==============================================================================================================================
1507	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
1508	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
1509	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
1510	!------------------------------------------------------------------------------------------------------------------------------
1511	INTEGER :: i
1512	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
1513	END FUNCTION new2oldH2O_m
1514	!==============================================================================================================================
1515
1516
1517	!==============================================================================================================================
1518	!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =======
1519	!==============================================================================================================================
1520	CHARACTER(LEN=maxlen) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
1521	TYPE(trac_type), INTENT(IN) :: t(:)
1522	CHARACTER(LEN=*), INTENT(IN) :: tname
1523	INTEGER, OPTIONAL, INTENT(IN) :: igen
1524	!------------------------------------------------------------------------------------------------------------------------------
1525	INTEGER :: ig, ix
1526	ig = 0; IF(PRESENT(igen)) ig = igen
1527	ix = idxAncestor_1(t, tname, ig)
1528	out = ''; IF(ix /= 0) out = t(ix)%name
1529	END FUNCTION ancestor_1
1530	!==============================================================================================================================
1531	FUNCTION ancestor_m(t, tname, igen) RESULT(out)
1532	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
1533	TYPE(trac_type), INTENT(IN) :: t(:)
1534	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1535	INTEGER, OPTIONAL, INTENT(IN) :: igen
1536	!------------------------------------------------------------------------------------------------------------------------------
1537	INTEGER, ALLOCATABLE :: ix(:)
1538	INTEGER :: ig
1539	ig = 0; IF(PRESENT(igen)) ig = igen
1540	IF( PRESENT(tname)) ix = idxAncestor_m(t, tname, ig)
1541	IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
1542	ALLOCATE(out(SIZE(ix))); out(:) = ''
1543	WHERE(ix /= 0) out = t(ix)%name
1544	END FUNCTION ancestor_m
1545	!==============================================================================================================================
1546
1547
1548	!==============================================================================================================================
1549	!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
1550	!==============================================================================================================================
1551	INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
1552	TYPE(trac_type), INTENT(IN) :: t(:)
1553	CHARACTER(LEN=*), INTENT(IN) :: tname
1554	INTEGER, OPTIONAL, INTENT(IN) :: igen
1555	!------------------------------------------------------------------------------------------------------------------------------
1556	INTEGER :: ig
1557	ig = 0; IF(PRESENT(igen)) ig = igen
1558	out = strIdx(t(:)%name, tname)
1559	IF(out == 0) RETURN !--- Tracer not found
1560	IF(t(out)%iGeneration <= ig) RETURN !--- Tracer has a lower generation number than asked generation 'igen"
1561	DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
1562	END FUNCTION idxAncestor_1
1563	!==============================================================================================================================
1564	FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
1565	INTEGER, ALLOCATABLE :: out(:)
1566	TYPE(trac_type), INTENT(IN) :: t(:)
1567	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1568	INTEGER, OPTIONAL, INTENT(IN) :: igen
1569	!------------------------------------------------------------------------------------------------------------------------------
1570	INTEGER :: ig, ix
1571	ig = 0; IF(PRESENT(igen)) ig = igen
1572	IF( PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix), ig), ix=1, SIZE(tname))]
1573	IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
1574	END FUNCTION idxAncestor_m
1575	!==============================================================================================================================
1576
1577
1578	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format