Context Navigation

source: readTracFiles_mod.f90 @ 16

Last change on this file since 16 was 16, checked in by dcugnet, 3 years ago
fixes in strTail_m and strHead_m "old" water names are management is simplified.
File size: 98.9 KB

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

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

Download in other formats:

Original Format