Context Navigation

readTracFiles_mod.f90 @ 4268

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

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

Download in other formats:

Original Format