Context Navigation

readTracFiles_mod.f90 @ 3852

Last change on this file since 3852 was 3852, checked in by dcugnet, 4 years ago

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

the number of tracers on the first line
one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

Format 2: read the sections from the "tracer.def" file.
format 3: read one section each "tracer_<section name>.def" file.
the first line of a section is "&<section name>
the other lines start with a tracer name followed by <key>=<val> pairs.
the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".

File size: 78.2 KB

Line
1	MODULE readTracFiles_mod
2
3	USE strings_mod, ONLY: msg, testFile, strFind, strStack, strCount, strHead, removeComment, dispTable, fmsg, &
4	cat, checkList, strIdx, strParse, strReplace, strTail, reduceExpr, modname, find, test
5	USE trac_types_mod, ONLY : tra, iso, db, kys
6
7	IMPLICIT NONE
8
9	PRIVATE
10
11	PUBLIC :: readTracersFiles, aliasTracer, tracersSubset, indexUpdate !--- TOOLS ASSOCIATED TO TRACERS DESCRIPTORS
12	PUBLIC :: readIsotopesFile !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
13	PUBLIC :: getKey_init, getKey, setDirectKeys !--- FUNCTIONS TO GET KEYS FROM tracers & isotopes
14
15	PUBLIC :: known_phases, nphases, phases_names, delPhase, addPhase !--- PHASES RELATED VARIABLES AND ROUTINES
16
17	PUBLIC :: tran0, idxAncestor, ancestor !--- GEN 0 TRACER + TOOLS FOR GENERATIONS
18
19	!------------------------------------------------------------------------------------------------------------------------------
20	INTERFACE getKey
21	MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, getKeyByName_sm, getKeyByName_im, getKeyByName_rm
22	END INTERFACE getKey
23	!------------------------------------------------------------------------------------------------------------------------------
24	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_Nam1; END INTERFACE tracersSubset
25	INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
26	INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m; END INTERFACE ancestor
27	INTERFACE addPhase; MODULE PROCEDURE addPhase_1, addPhase_m; END INTERFACE addPhase
28	!------------------------------------------------------------------------------------------------------------------------------
29
30	!=== MAIN DATABASE: files sections descriptors
31	TYPE(db), SAVE, ALLOCATABLE, TARGET :: dBase(:)
32
33	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
34	CHARACTER(LEN=256), SAVE :: tran0 = 'air' !--- Default transporting fluid
35	CHARACTER(LEN=256), PARAMETER :: known_phases = 'gls' !--- Known phases initials
36	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
37	CHARACTER(LEN=256), SAVE :: phases_names(nphases) & !--- Known phases names
38	= ['gaseous', 'liquid ', 'solid ']
39	LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists
40	LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation
41
42	!=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
43	TYPE(tra), ALLOCATABLE, TARGET, SAVE :: tracers(:)
44	TYPE(iso), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
45
46
47	CONTAINS
48
49	!==============================================================================================================================
50	!==============================================================================================================================
51	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
52	!=== THE RETURN VALUE fType DEPENDS ON WHAT IS FOUND:
53	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
54	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
55	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
56	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
57	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
58	!=== REMARKS:
59	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
60	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
61	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
62	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
63	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
64	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
65	!=== ABOUT THE KEYS:
66	! * The "keys" component (of type kys) is in principle enough to store everything we could need.
67	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
68	! * Most of the direct-access keys are set in this module, but some are not (lnam, iadv and itr for example).
69	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
70	! is extracted: the indexes are no longer valid for a subset (examples: tracers(:)iprnt or tracers(:)%ichld).
71	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
72	!==============================================================================================================================
73	LOGICAL FUNCTION readTracersFiles(type_trac, fType, tracs) RESULT(lerr)
74	!------------------------------------------------------------------------------------------------------------------------------
75	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
76	INTEGER, INTENT(OUT) :: fType !--- Type of input file found
77	TYPE(tra), ALLOCATABLE, INTENT(OUT) :: tracs(:)
78	CHARACTER(LEN=256), ALLOCATABLE :: s(:), sections(:), trac_files(:)
79	CHARACTER(LEN=256) :: str, fname, mesg
80	INTEGER :: is, nsec, ierr, it, ntrac, ns
81	LOGICAL, ALLOCATABLE :: ll(:), lGen3(:)
82	!------------------------------------------------------------------------------------------------------------------------------
83	lerr = .FALSE.
84	modname = 'readTracersFiles'
85	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
86
87	!--- Required sections + corresponding files names (new style single section case)
88	IF(test(strParse(type_trac, ',', sections), lerr)) RETURN !--- Parse "type_trac" list
89
90	nsec = SIZE(sections, DIM=1)
91	ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
92
93	!--- LOOK AT AVAILABLE FILES
94	ll = .NOT.testFile(trac_files)
95	fType = 0
96	IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1 !--- OLD STYLE FILE
97	IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
98	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
99	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
100	IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
101	END IF
102
103	!--- TELLS WHAT WAS IS ABOUT TO BE USED
104	IF(test(fmsg(fType==0, 'No adequate tracers description file(s) found ; default values will be used'), lerr)) RETURN
105	CALL msg(fType==1, 'Trying to read old-style tracers description file "traceur.def"')
106	CALL msg(fType==2, 'Trying to read the new style multi-sections tracers description file "tracer.def"')
107	CALL msg(fType==3, 'Trying to read the new style single section tracers description files "tracer_*.def"')
108
109	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
110	IF(fType==1) THEN !=== OLD FORMAT "traceur.def"
111	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
112	!--- OPEN THE "traceur.def" FILE
113	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
114
115	!--- GET THE TRACERS NUMBER
116	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
117	IF(test(fmsg(ierr /= 0, 'Invalid format for "'//TRIM(fname)//'"'), lerr)) RETURN
118
119	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
120	ALLOCATE(tracs(ntrac))
121	DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number
122	READ(90,'(a)',IOSTAT=ierr) str
123	IF(test(fmsg(ierr>0, 'Invalid format for "' //TRIM(fname)//'"'), lerr)) RETURN
124	IF(test(fmsg(ierr<0, 'Not enough lines in "'//TRIM(fname)//'"'), lerr)) RETURN
125	ll = strParse(str, ' ', s, n=ns)
126	tracs(it)%keys%key = ['hadv', 'vadv']
127	tracs(it)%keys%val = s(1:2)
128	CALL msg(ns == 3 .AND. it == 1, 'This file is for air tracers only')
129	CALL msg(ns == 4 .AND. it == 1, 'This files specifies the transporting fluid')
130	SELECT CASE(s(3)) !--- name and phase of the tracer
131	CASE('H2Ov'); tracs(it)%name = 'H2O-g'; tracs(it)%phas = 'g'
132	CASE('H2Ol'); tracs(it)%name = 'H2O-l'; tracs(it)%phas = 'l'
133	CASE('H2Oi'); tracs(it)%name = 'H2O-s'; tracs(it)%phas = 's'
134	CASE DEFAULT; tracs(it)%name = s(3) ; tracs(it)%phas = 'g'
135	END SELECT
136	tracs(it)%prnt = tran0 !--- Default transporting fluid: Air
137	IF(ns == 4) tracs(it)%prnt = s(4) !--- Transporting fluid name
138	END DO
139	CLOSE(90)
140
141	lGen3 = tracs%igen==3
142	CALL setGeneration(tracs) !--- Determine tracs(:)%igen values
143	IF(test(checkTracers(tracs, fname,fname),lerr)) RETURN !--- Detect orphans and check phases
144	IF(test(checkUnique (tracs,lGen3,fname,fname),lerr)) RETURN !--- Detect repeated tracers
145	CALL sortTracers (tracs) !--- Sort the tracers
146	CALL setDirectKeys(tracs) !--- Set the directly accessible keys
147	tracs(:)%keys%name = tracs(:)%name !--- Copy tracers names in keys components
148	RETURN
149	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
150	END IF
151	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
152
153	!=== USING NEW FORMAT TRACERS DESCRIPTION FILES WITH POSSIBLY SEVERAL SECTIONS
154	CALL msg(nsec > 1 .AND. tracs_merge, 'The multiple required sections will be MERGED.')
155	CALL msg(nsec > 1 .AND. .NOT.tracs_merge, 'The multiple required sections will be CUMULATED.')
156
157	!=== FEED THE DATABASE WITH THE RAW CONTENT OF THE FILE
158	SELECT CASE(fType)
159	CASE(2); lerr = feedDBase(["tracer.def"],[type_trac]) !--- Single file, coma-separated sections list
160	CASE(3); lerr = feedDBase(trac_files, sections ) !--- Multiple files, one section name each file
161	END SELECT
162	IF(lerr) RETURN
163	IF( tracs_merge) lerr = mergeTracers(dBase, tracs) !--- MERGE THE COMPONENTS OF THE DATABASE
164	IF(.NOT.tracs_merge) lerr = cumulTracers(dBase, tracs) !--- CUMULATE THE COMPONENTS OF THE DATABASE
165	IF(lerr) RETURN
166	CALL setDirectKeys(tracs) !--- Set the directly accessible keys
167
168	END FUNCTION readTracersFiles
169	!==============================================================================================================================
170
171	!==============================================================================================================================
172	LOGICAL FUNCTION feedDBase(fnames, snames) RESULT(lerr)
173	! Purpose: Read the sections "snames(is)" (coma-separated list) from each "fnames(is)"
174	! file and create the corresponding tracers set descriptors in the database "dBase":
175	! * dBase(id)%name : section name
176	! * dBase(id)%trac(:)%name : tracers names
177	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
178	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
179	!------------------------------------------------------------------------------------------------------------------------------
180	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
181	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Coma-deparated list of sections (one list each file)
182	INTEGER, ALLOCATABLE :: ndb(:) !--- Nuber of sections for each file
183	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
184	LOGICAL, ALLOCATABLE :: lTg(:) !--- Tagging tracers mask
185	CHARACTER(LEN=256) :: fnm, snm
186	INTEGER :: idb, i
187	LOGICAL :: ll
188	!------------------------------------------------------------------------------------------------------------------------------
189
190	!=== READ THE REQUIRED SECTIONS
191	ll = strCount(snames, ',', ndb) !--- Number of sections for each file
192	ALLOCATE(ixf(SUM(ndb)))
193	DO i=1, SIZE(fnames)
194	IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
195	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
196	END DO
197	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
198	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
199	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
200	fnm = fnames(ixf(idb)); snm = dBase(idb)%name
201	IF(test(expandSection(dBase(idb)%trac, snm, fnm),lerr)) RETURN !--- EXPAND NAMES AND PARENTS LISTS
202	CALL setGeneration (dBase(idb)%trac) !--- DETERMINE GENERATION NUMBER
203	IF(test(checkTracers (dBase(idb)%trac, snm, fnm),lerr)) RETURN !--- CHECK ORPHANS AND PHASES
204	lTg = dBase(idb)%trac(:)%type == 'tag' !--- Flag for tagging tracers
205	IF(test(checkUnique (dBase(idb)%trac,lTg,snm,fnm),lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
206	CALL expandPhases (dBase(idb)%trac) !--- EXPAND THE PHASES
207	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
208	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
209	END DO
210	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
211
212	!=== DISPLAY BASIC INFORMATION
213	lerr = ANY([(dispTraSection('Expanded list for section "'//TRIM(dBase(idb)%name)//'"',dBase(idb)%name), idb=1, SIZE(dBase))])
214	END FUNCTION feedDBase
215	!------------------------------------------------------------------------------------------------------------------------------
216
217	!------------------------------------------------------------------------------------------------------------------------------
218	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
219	!------------------------------------------------------------------------------------------------------------------------------
220	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
221	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Coma-separated sections list
222	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
223	!------------------------------------------------------------------------------------------------------------------------------
224	TYPE(db), ALLOCATABLE :: tdb(:)
225	CHARACTER(LEN=256), ALLOCATABLE :: sec(:)
226	INTEGER, ALLOCATABLE :: ix(:)
227	INTEGER :: n0, idb, ndb
228	LOGICAL :: ll
229	!------------------------------------------------------------------------------------------------------------------------------
230	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
231	CALL readSections_all() !--- Read all the sections of file "fnam"
232	ndb= SIZE(dBase) !--- Current number of sections in the database
233	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
234	DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
235	END IF
236	ll = strParse(snam, ',', keys = sec) !--- Requested sections names
237	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
238	IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
239	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
240
241	CONTAINS
242
243	!------------------------------------------------------------------------------------------------------------------------------
244	SUBROUTINE readSections_all()
245	!------------------------------------------------------------------------------------------------------------------------------
246	CHARACTER(LEN=256), ALLOCATABLE :: s(:), v(:)
247	TYPE(tra), ALLOCATABLE :: tt(:)
248	TYPE(tra) :: tmp
249	CHARACTER(LEN=1024) :: str
250	CHARACTER(LEN=256) :: secn
251	INTEGER :: ierr, n
252	!------------------------------------------------------------------------------------------------------------------------------
253	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
254	OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
255	DO; READ(90,'(a)', IOSTAT=ierr)str
256	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
257	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
258	CALL removeComment(str) !--- Skip comments at the end of a line
259	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
260	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
261	ndb = SIZE(dBase) !--- Number of sections so far
262	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
263	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
264	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
265	ndb = ndb + 1 !--- Extend database
266	ALLOCATE(tdb(ndb))
267	tdb(1:ndb-1) = dBase
268	tdb(ndb)%name = secn
269	ALLOCATE(tdb(ndb)%trac(0))
270	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
271	ELSE !=== TRACER LINE
272	ll = strParse(str,' ', keys = s, vals = v, n = n) !--- Parse <key>=<val> pairs
273	tt = dBase(ndb)%trac(:)
274	tmp%name = s(1); tmp%keys = kys(s(1), s(2:n), v(2:n))
275	dBase(ndb)%trac = [tt(:), tmp]
276	DEALLOCATE(tt)
277	! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), comp=secn, keys=kys(s(1), s(2:n), v(2:n)))]
278	END IF
279	END DO
280	CLOSE(90)
281
282	END SUBROUTINE readSections_all
283	!------------------------------------------------------------------------------------------------------------------------------
284
285	END FUNCTION readSections
286	!==============================================================================================================================
287
288
289	!==============================================================================================================================
290	SUBROUTINE addDefault(t, defName)
291	!------------------------------------------------------------------------------------------------------------------------------
292	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
293	!------------------------------------------------------------------------------------------------------------------------------
294	TYPE(tra), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
295	CHARACTER(LEN=*), INTENT(IN) :: defName
296	INTEGER :: i0, it, k
297	TYPE(kys), POINTER :: k0
298	TYPE(tra), ALLOCATABLE :: tt(:)
299	i0 = strIdx(t(:)%name, defName)
300	IF(i0 == 0) RETURN
301	k0 => t(i0)%keys
302	DO k = 1, SIZE(k0%key) !--- Loop on the keys of the tracer named "defName"
303	CALL addKey_tra(TRIM(k0%key(k)), TRIM(k0%val(k)), t) !--- Add key to all the tracers (no overwriting)
304	END DO
305	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
306	END SUBROUTINE addDefault
307	!==============================================================================================================================
308
309	!==============================================================================================================================
310	SUBROUTINE subDefault(t, defName, lSubLocal)
311	!------------------------------------------------------------------------------------------------------------------------------
312	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
313	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
314	!------------------------------------------------------------------------------------------------------------------------------
315	TYPE(tra), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
316	CHARACTER(LEN=*), INTENT(IN) :: defName
317	LOGICAL, INTENT(IN) :: lSubLocal
318	INTEGER :: i0, it, ik
319	TYPE(kys), POINTER :: k0, ky
320	TYPE(tra), ALLOCATABLE :: tt(:)
321	i0 = strIdx(t(:)%name, defName)
322	IF(i0 == 0) RETURN
323	k0 => t(i0)%keys
324	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
325	ky => t(it)%keys
326
327	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
328	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
329
330	IF(.NOT.lSubLocal) CYCLE
331	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
332	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
333	END DO
334	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
335
336	END SUBROUTINE subDefault
337	!==============================================================================================================================
338
339
340
341
342	!==============================================================================================================================
343	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
344	!------------------------------------------------------------------------------------------------------------------------------
345	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
346	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
347	! * Default values are provided for these keys because they are necessary.
348	!------------------------------------------------------------------------------------------------------------------------------
349	TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
350	CHARACTER(LEN=*), INTENT(IN) :: sname
351	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname
352	TYPE(tra), ALLOCATABLE :: ttr(:)
353	CHARACTER(LEN=256), ALLOCATABLE :: ta(:), pa(:)
354	CHARACTER(LEN=256) :: msg1
355	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
356	LOGICAL :: ll
357	lerr = .FALSE.
358	nt = SIZE(tr)
359	nq = 0
360	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
361	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
362	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
363	!--- Extract useful keys: parent name, type, component name
364	tr(it)%prnt = fgetKey(it, 'parent', tr(:)%keys, tran0 )
365	tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer')
366	tr(it)%comp = sname
367
368	!--- Determine the number of tracers and parents ; coherence checking
369	ll = strCount(tr(it)%name, ',', ntr)
370	ll = strCount(tr(it)%prnt, ',', npr)
371
372	!--- Tagging tracers only can have multiple parents
373	IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
374	msg1 = 'Check section "'//TRIM(sname)//'"'
375	IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
376	CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag'); RETURN
377	END IF
378	nq = nq + ntr*npr
379	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
380	END DO
381	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
382	CALL delKey(['parent','type '], tr)
383
384	ALLOCATE(ttr(nq))
385	iq = 1
386	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
387	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
388	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
389	ll = strParse(tr(it)%name, ',', ta, n=ntr) !--- Number of tracers
390	ll = strParse(tr(it)%prnt, ',', pa, n=npr) !--- Number of parents
391	DO ipr=1,npr !--- Loop on parents list elts
392	DO itr=1,ntr !--- Loop on tracers list elts
393	i = iq+itr-1+(ipr-1)*ntr
394	ttr(i)%name = ta(itr); ttr(i)%prnt = pa(ipr)
395	ttr(i)%keys = kys(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
396	END DO
397	END DO
398	ttr(iq:iq+ntr*npr-1)%type = tr(it)%type !--- Duplicating type
399	iq = iq + ntr*npr
400	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
401	END DO
402	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
403	DEALLOCATE(ta,pa)
404	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
405
406	END FUNCTION expandSection
407	!==============================================================================================================================
408
409	!==============================================================================================================================
410	SUBROUTINE setGeneration(tr)
411	!------------------------------------------------------------------------------------------------------------------------------
412	! Purpose: Determine, for each tracer of "tr(:)":
413	! * the generation number
414	! * the first generation ancestor name
415	!------------------------------------------------------------------------------------------------------------------------------
416	! Arguments:
417	TYPE(tra), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
418	!------------------------------------------------------------------------------------------------------------------------------
419	! Local variables:
420	INTEGER :: iq, nq, ig
421	LOGICAL, ALLOCATABLE :: lg(:)
422	CHARACTER(LEN=256), ALLOCATABLE :: prn(:)
423	!------------------------------------------------------------------------------------------------------------------------------
424	tr(:)%igen = 0 !--- error if 0
425	nq = SIZE(tr, DIM=1) !--- Number of tracers lines
426	lg = tr(:)%prnt == tran0 !--- First generation tracers flag
427	WHERE(lg) tr(:)%igen = 1 !--- First generation tracers
428
429	!=== Determine generation for each tracer
430	ig=0; prn = [tran0]
431	DO !--- Update current generation flag
432	IF(ig/=0) prn = PACK( tr(:)%name, MASK=tr(:)%igen == ig)
433	lg(:) = [(ANY(prn(:) == tr(iq)%prnt), iq=1, nq)] !--- Current generation tracers flag
434	IF( ALL( .NOT. lg ) ) EXIT !--- Empty current generation
435	ig = ig+1; WHERE(lg) tr(:)%igen = ig
436	END DO
437	tr(:)%nam1 = ancestor(tr) !--- First generation ancestor name
438
439	END SUBROUTINE setGeneration
440	!==============================================================================================================================
441
442	!==============================================================================================================================
443	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
444	!------------------------------------------------------------------------------------------------------------------------------
445	! Purpose:
446	! * check for orphan tracers (without known parent)
447	! * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
448	!------------------------------------------------------------------------------------------------------------------------------
449	TYPE(tra), INTENT(IN) :: tr(:) !--- Tracer derived type vector
450	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
451	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
452	CHARACTER(LEN=256) :: mesg
453	CHARACTER(LEN=256) :: bp(SIZE(tr, DIM=1)), pha
454	CHARACTER(LEN=1) :: p
455	INTEGER :: ip, np, iq, nq
456	!------------------------------------------------------------------------------------------------------------------------------
457	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
458	mesg = 'Check section "'//TRIM(sname)//'"'
459	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
460
461	!=== CHECK FOR ORPHAN TRACERS
462	IF(test(checkList(tr%name, tr%igen==0, mesg, 'tracers', 'orphan'), lerr)) RETURN
463
464	!=== CHECK PHASES
465	DO iq=1,nq; IF(tr(iq)%igen/=1) CYCLE !--- Generation 1 only is checked
466	pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases
467	np = LEN_TRIM(pha); bp(iq)=' '
468	DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
469	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
470	END DO
471	lerr = checkList(bp, tr%igen==1 .AND. bp/='', mesg, 'tracers phases', 'unknown')
472	END FUNCTION checkTracers
473	!==============================================================================================================================
474
475	!==============================================================================================================================
476	LOGICAL FUNCTION checkUnique(tr, lTag, sname, fname) RESULT(lerr)
477	!------------------------------------------------------------------------------------------------------------------------------
478	! Purpose: Make sure that tracers are not repeated.
479	!------------------------------------------------------------------------------------------------------------------------------
480	TYPE(tra), INTENT(IN) :: tr(:) !--- Tracer derived type vector
481	LOGICAL, INTENT(IN) :: lTag(:) !--- Tagging tracer flag
482	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
483	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
484	!------------------------------------------------------------------------------------------------------------------------------
485	INTEGER :: ip, np, iq, nq, k
486	LOGICAL, ALLOCATABLE :: ll(:)
487	CHARACTER(LEN=256) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
488	CHARACTER(LEN=1) :: p
489	!------------------------------------------------------------------------------------------------------------------------------
490	mesg = 'Check section "'//TRIM(sname)//'"'
491	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
492	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
493	tdup(:) = ''
494	DO iq=1,nq; IF(lTag(iq)) CYCLE !--- Tags can be repeated
495	tnam = tr(iq)%name
496	ll = tr(:)%name==tnam !--- Mask for current tracer name
497	IF(COUNT(ll)==1 ) CYCLE !--- Tracer is not repeated
498	IF(tr(iq)%igen>1) THEN
499	tdup(iq) = tnam !--- gen>1: MUST be unique
500	ELSE
501	DO ip=1,nphases; p=known_phases(ip:ip) !--- Loop on known phases
502	!--- Number of appearances of the current tracer with known phase "p"
503	np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
504	IF(np <=1) CYCLE
505	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
506	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
507	END DO
508	END IF
509	IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
510	END DO
511	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
512	END FUNCTION checkUnique
513	!==============================================================================================================================
514
515	!==============================================================================================================================
516	SUBROUTINE expandPhases(tr)
517	!------------------------------------------------------------------------------------------------------------------------------
518	! Purpose: Expand the phases in the tracers descriptor "tr".
519	!------------------------------------------------------------------------------------------------------------------------------
520	TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
521	!------------------------------------------------------------------------------------------------------------------------------
522	TYPE(tra), ALLOCATABLE :: ttr(:)
523	INTEGER, ALLOCATABLE :: i0(:)
524	CHARACTER(LEN=256) :: nam, pha, trn
525	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
526	LOGICAL :: lTg, lEx
527	!------------------------------------------------------------------------------------------------------------------------------
528	nq = SIZE(tr, DIM=1)
529	nt = 0
530	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
531	IF(tr(iq)%igen /= 1) CYCLE
532	nc = COUNT(tr(:)%nam1==tr(iq)%name .AND. tr%igen/=1) !--- Number of childs of tr(iq)
533	tr(iq)%phas = fgetKey(iq, 'phases', tr(:)%keys) !--- Phases list of tr(iq)
534	np = LEN_TRIM(tr(iq)%phas) !--- Number of phases of tr(iq)
535	nt = nt + (1+nc) * np !--- Number of tracers after expansion
536	END DO
537	ALLOCATE(ttr(nt))
538	it = 1 !--- Current "ttr(:)" index
539	DO iq = 1, nq !--- Loop on "tr(:)" indexes
540	lTg = tr(iq)%type=='tag' !--- Current tracer is a tag
541	i0 = strFind(tr(:)%name, tr(iq)%nam1, n) !--- Indexes of first generation ancestor copies
542	np = SUM( [( LEN_TRIM(tr(i0(i))%phas),i=1,n )],1) !--- Number of phases for current tracer tr(iq)
543	lEx = np>1 !--- Need of a phase suffix
544	IF(lTg) lEx=lEx.AND.tr(iq)%igen>1 !--- No phase suffix for first generation tags
545	DO i=1,n !=== LOOP ON FIRST GENERATION ANCESTORS
546	jq=i0(i) !--- tr(jq): ith copy of 1st gen. ancestor of tr(iq)
547	IF(tr(iq)%igen==1) jq=iq !--- Generation 1: current tracer phases only
548	pha = tr(jq)%phas !--- Phases list for tr(jq)
549	DO ip=1,LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
550	trn=TRIM(tr(iq)%name); nam=trn !--- Tracer name (regular case)
551	IF(lTg) nam = TRIM(tr(iq)%prnt) !--- Parent name (tagging case)
552	IF(lEx) nam = TRIM(nam)//'-'//pha(ip:ip) !--- Phase extension needed
553	IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn) !--- <parent>_<name> for tags
554	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
555	ttr(it)%name = nam !--- Name with possibly phase suffix
556	ttr(it)%keys%name = nam !--- Name inside the keys decriptor
557	ttr(it)%phas = pha(ip:ip) !--- Single phase entry
558	IF(lEx.AND.tr(iq)%igen>1) THEN
559	ttr(it)%prnt = TRIM(ttr(it)%prnt)//'-'//pha(ip:ip)
560	ttr(it)%nam1 = TRIM(ttr(it)%nam1)//'-'//pha(ip:ip)
561	END IF
562	it=it+1
563	END DO
564	IF(tr(iq)%igen==1) EXIT !--- Break phase loop for gen 1
565	END DO
566	END DO
567	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
568	CALL delKey(['phases'],tr) !--- Remove few keys entries
569
570	END SUBROUTINE expandPhases
571	!==============================================================================================================================
572
573	!==============================================================================================================================
574	SUBROUTINE sortTracers(tr)
575	!------------------------------------------------------------------------------------------------------------------------------
576	! Purpose: Sort tracers:
577	! * lGrowGen == T: in ascending generations numbers.
578	! * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
579	!------------------------------------------------------------------------------------------------------------------------------
580	TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
581	INTEGER :: ig, ng, iq, jq, n, ix(SIZE(tr)), k
582	INTEGER, ALLOCATABLE :: iy(:), iz(:)
583	!------------------------------------------------------------------------------------------------------------------------------
584	iq = 1
585	IF(lSortByGen) THEN
586	ng = MAXVAL(tr(:)%igen, MASK=.TRUE., DIM=1) !--- Number of generations
587	DO ig = 0, ng !--- Loop on generations
588	iy = PACK([(k, k=1, SIZE(tr))], MASK=tr(:)%igen==ig) !--- Generation ig tracers indexes
589	n = SIZE(iy)
590	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
591	iq = iq + n
592	END DO
593	ELSE
594	DO jq = 1, SIZE(tr,DIM=1) !--- Loop on first generation tracers
595	IF(tr(jq)%igen /= 1) CYCLE !--- Skip generations >= 1
596	ix(iq) = jq !--- First generation ancestor index first
597	iq = iq + 1
598	iy = strFind(tr(:)%nam1, tr(jq)%name) !--- Indexes of "tr(jq)" childs in "tr(:)"
599	ng = MAXVAL(tr(iy)%igen, MASK=.TRUE., DIM=1) !--- Generations number of the "tr(jq)" family
600	DO ig = 2, ng !--- Loop on generations for the tr(jq) family
601	iz = find(tr(iy)%igen, ig, n) !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
602	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
603	iq = iq + n
604	END DO
605	END DO
606	END IF
607	tr = tr(ix) !--- Reorder the tracers
608	END SUBROUTINE sortTracers
609	!==============================================================================================================================
610
611	!==============================================================================================================================
612	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
613	TYPE(db), TARGET, INTENT(IN) :: sections(:)
614	TYPE(tra), ALLOCATABLE, INTENT(OUT) :: tr(:)
615	TYPE(tra), POINTER :: t1(:), t2(:)
616	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
617	INTEGER :: is, k1, k2, nk2, i1, i2, nt2
618	CHARACTER(LEN=256) :: s1, v1, v2, tnam, knam
619	lerr = .FALSE.
620	t1 => sections(1)%trac(:) !--- Alias: first tracers section
621	tr = t1
622	!----------------------------------------------------------------------------------------------------------------------------
623	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
624	!----------------------------------------------------------------------------------------------------------------------------
625	t2 => sections(is)%trac(:) !--- Alias: current tracers section
626	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
627	ixct = strIdx(t1(:)%name, t2(:)%name) !--- Indexes of common tracers
628	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
629	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
630	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":')
631	CALL msg( t1(PACK(ixct, MASK = ixct/=0))%name, nmax=128 ) !--- Display duplicates (the 128 first at most)
632	!--------------------------------------------------------------------------------------------------------------------------
633	DO i2=1,nt2; tnam = t2(i2)%name !=== LOOP ON COMMON TRACERS
634	!--------------------------------------------------------------------------------------------------------------------------
635	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
636
637	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
638	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
639
640	IF(test(fmsg(t1(i1)%prnt /= t2(i2)%prnt, 'Parent name'//TRIM(s1)), lerr)) RETURN
641	IF(test(fmsg(t1(i1)%type /= t2(i2)%type, 'Type' //TRIM(s1)), lerr)) RETURN
642	IF(test(fmsg(t1(i1)%igen /= t2(i2)%igen, 'Generation' //TRIM(s1)), lerr)) RETURN
643
644	!=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
645	nk2 = SIZE(t2(i2)%keys%key(:)) !--- Keys number in current section
646	ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:)) !--- Common keys indexes
647
648	!=== APPEND NEW KEYS
649	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
650	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
651
652	!--- KEEP TRACK OF THE COMPONENTS NAMES
653	tr(i1)%comp = TRIM(tr(i1)%comp)//','//TRIM(tr(i2)%comp)
654
655	!--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
656	DO k2=1,nk2
657	k1 = ixck(k2); IF(k1 == 0) CYCLE
658	IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
659	END DO
660	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values
661
662	!--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
663	CALL msg('Key(s)'//TRIM(s1))
664	DO k2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
665	knam = t2(i2)%keys%key(k2) !--- Name of the current key
666	k1 = ixck(k2) !--- Corresponding index in t1(:)
667	IF(k1 == 0) CYCLE !--- New keys are skipped
668	v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2) !--- Key values in t1(:) and t2(:)
669	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1))
670	END DO
671	!------------------------------------------------------------------------------------------------------------------------
672	END DO
673	!--------------------------------------------------------------------------------------------------------------------------
674	END DO
675	CALL sortTracers(tr)
676
677	END FUNCTION mergeTracers
678	!==============================================================================================================================
679
680	!==============================================================================================================================
681	LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
682	TYPE(db), TARGET, INTENT(IN) :: sections(:)
683	TYPE(tra), ALLOCATABLE, INTENT(OUT) :: tr(:)
684	TYPE(tra), POINTER :: t1(:), t2(:)
685	INTEGER, ALLOCATABLE :: nt(:)
686	CHARACTER(LEN=256) :: tnam, tnam_new
687	INTEGER :: iq, nq, is, ns, nsec
688	lerr = .FALSE. !--- Can't fail ; kept to match "mergeTracer" interface.
689	nsec = SIZE(sections)
690	tr = [( sections(is)%trac(:) , is=1, nsec )] !--- Concatenated tracers vector
691	nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )] !--- Number of tracers in each section
692	!----------------------------------------------------------------------------------------------------------------------------
693	DO is=1, nsec !=== LOOP ON SECTIONS
694	!----------------------------------------------------------------------------------------------------------------------------
695	t1 => sections(is)%trac(:)
696	!--------------------------------------------------------------------------------------------------------------------------
697	DO iq=1, nt(is) !=== LOOP ON TRACERS
698	!--------------------------------------------------------------------------------------------------------------------------
699	tnam = t1(iq)%name !--- Original name
700	IF(COUNT(t1%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished
701	tnam_new = TRIM(tnam)//'-'//TRIM(sections(is)%name) !--- Same with section extension
702	nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections
703	ns = nt(is) !--- Number of tracers in the current section
704	tr(iq + nq)%name = tnam_new !--- Modify tracer name
705	WHERE(tr(1+nq:ns+nq)%prnt==tnam) tr(1+nq:ns+nq)%prnt=tnam_new !--- Modify parent name
706	!--------------------------------------------------------------------------------------------------------------------------
707	END DO
708	!----------------------------------------------------------------------------------------------------------------------------
709	END DO
710	!----------------------------------------------------------------------------------------------------------------------------
711	CALL sortTracers(tr)
712	END FUNCTION cumulTracers
713	!==============================================================================================================================
714
715	!==============================================================================================================================
716	SUBROUTINE setDirectKeys(tr)
717	TYPE(tra), INTENT(INOUT) :: tr(:)
718	CALL indexUpdate(tr) !--- Update iparnt and idesc indexes vectors
719	! DO iq = 1, SIZE(tr)
720	! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, tran0 ) !--- For additional keys
721	! END DO
722	END SUBROUTINE setDirectKeys
723	!==============================================================================================================================
724
725	!==============================================================================================================================
726	LOGICAL FUNCTION dispTraSection(message, sname) RESULT(lerr)
727	CHARACTER(LEN=*), INTENT(IN) :: message
728	CHARACTER(LEN=*), INTENT(IN) :: sname
729	INTEGER :: idb, iq, nq
730	INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
731	TYPE(tra), POINTER :: tm(:)
732	lerr = .FALSE.
733	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
734	tm => dBase(idb)%trac
735	nq = SIZE(tm)
736	IF(test(getKeyByName_im('hadv', hadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
737	IF(test(getKeyByName_im('vadv', vadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
738	CALL msg(TRIM(message)//':')
739	IF(test(dispTable('iiissis', ['iq ','hadv ','vadv ','short name','parent ','igen ','phase '], &
740	cat(tm(:)%name, tm(:)%prnt, tm(:)%phas), cat([(iq, iq=1, nq)], hadv, vadv, tm(:)%igen)), lerr)) RETURN
741	END FUNCTION dispTraSection
742	!==============================================================================================================================
743	!==============================================================================================================================
744
745
746	!==============================================================================================================================
747	!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
748	!==============================================================================================================================
749	FUNCTION aliasTracer(tname, t) RESULT(out)
750	TYPE(tra), POINTER :: out
751	CHARACTER(LEN=*), INTENT(IN) :: tname
752	TYPE(tra), TARGET, INTENT(IN) :: t(:)
753	INTEGER :: it
754	it = strIdx(t(:)%name, tname)
755	out => NULL(); IF(it /= 0) out => t(it)
756	END FUNCTION aliasTracer
757	!------------------------------------------------------------------------------------------------------------------------------
758
759
760	!==============================================================================================================================
761	!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
762	!==============================================================================================================================
763	FUNCTION trSubset_Indx(trac,idx) RESULT(out)
764	TYPE(tra), ALLOCATABLE :: out(:)
765	TYPE(tra), ALLOCATABLE, INTENT(IN) :: trac(:)
766	INTEGER, INTENT(IN) :: idx(:)
767	out = trac(idx)
768	CALL indexUpdate(out)
769	END FUNCTION trSubset_Indx
770	!------------------------------------------------------------------------------------------------------------------------------
771	FUNCTION trSubset_Name(trac,nam) RESULT(out)
772	TYPE(tra), ALLOCATABLE :: out(:)
773	TYPE(tra), ALLOCATABLE, INTENT(IN) :: trac(:)
774	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
775	out = trac(strIdx(trac(:)%name, nam))
776	CALL indexUpdate(out)
777	END FUNCTION trSubset_Name
778	!------------------------------------------------------------------------------------------------------------------------------
779
780
781	!==============================================================================================================================
782	!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
783	!==============================================================================================================================
784	FUNCTION trSubset_Nam1(trac,nam) RESULT(out)
785	TYPE(tra), ALLOCATABLE :: out(:)
786	TYPE(tra), ALLOCATABLE, INTENT(IN) :: trac(:)
787	CHARACTER(LEN=*), INTENT(IN) :: nam
788	out = trac(strFind(delPhase(trac(:)%nam1), nam))
789	CALL indexUpdate(out)
790	END FUNCTION trSubset_Nam1
791	!------------------------------------------------------------------------------------------------------------------------------
792
793
794	!==============================================================================================================================
795	!=== UPDATE THE INDEXES iparnt(:), idesc=(:) AND igen(:) IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) ============
796	!==============================================================================================================================
797	SUBROUTINE indexUpdate(tr)
798	TYPE(tra), INTENT(INOUT) :: tr(:)
799	INTEGER :: iq, ig, ng, ngen
800	INTEGER, ALLOCATABLE :: ix(:)
801	tr(:)%iprnt = strIdx( tr(:)%name, tr(:)%prnt ) !--- Parent index
802	ngen = MAXVAL(tr(:)%igen, MASK=.TRUE.)
803	DO iq = 1, SIZE(tr)
804	ng = tr(iq)%igen !--- Generation of the current tracer
805	ix = idxAncestor(tr, igen = ng); ix = PACK(ix, ix/=0) !--- Indexes of the tracers with ancestor tr(iq)
806	!--- Childs indexes in growing generation order
807	tr(iq)%idesc = [( PACK(ix, MASK = tr(ix)%igen == ig), ig = ng+1, ngen)]
808	tr(iq)%ndesc = SUM( [( COUNT(tr(ix)%igen == ig), ig = ng+1, ngen)] )
809	tr(iq)%nchld = COUNT(tr(ix)%igen == ng+1)
810	END DO
811	END SUBROUTINE indexUpdate
812	!------------------------------------------------------------------------------------------------------------------------------
813
814
815	!==============================================================================================================================
816	!=== READ THE ISOTOPES NAMED "iso" FROM THE TRACERS SECTIONS "tr" IN THE FILE "fnam" ; PUT RESULT IN A TRACERS DESCRIPTOR ====
817	!=== * SYNTAX IS THE SAME AS IN THE "tracer.def" FILE ; EACH TRACER SECTION CONTAINS ONE LINE EACH OF ITS KNOWN ISOTOPES ====
818	!=== * EACH TRACERS SECTION CAN CONTAIN A "params" VIRTUAL ISOTOPE LINE CONTAINING DEFAULT PARAMETERS FOR THE ISOTOPES ====
819	!=== * IF SOME KEYS ARE FOUND BOTH IN THE ".def" FILES AND THE "params" SECTION, TEH VALUE FROM ".def" FILE IS RETAINED ====
820	!=== * ON EACH ISOTOPE LINE, A DEFINED KEY CAN BE USED IN THE OTHER KEYS AS A PARAMETER (SIGNLE LEVEL DEPENDENCY !) ====
821	!=== * THE DIFFERENT ISOTOPES SETS (ONE EACH PARENT TRACER) ARE MERGED INTO A SINGLE TRACERS DESCRIPTOR VECTOR ====
822	!=== * THE ROUTINE GIVES AN ERROR IF A REQUIRED ISOTOPE IS NOT AVAILABLE IN THE DATABASE STORED IN "fnam" ====
823	!==============================================================================================================================
824
825	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
826	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
827	TYPE(iso), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field "prnt" must be defined !)
828	INTEGER :: ik, is, it, idb, nk0, i
829	INTEGER :: nk, ns, nt, ndb, nb0, i0
830	CHARACTER(LEN=256), POINTER :: k(:), v(:), k0(:), v0(:)
831	CHARACTER(LEN=256), ALLOCATABLE :: vals(:)
832	CHARACTER(LEN=256) :: val
833	TYPE(kys), POINTER :: ky(:)
834	TYPE(tra), POINTER :: t(:)
835	TYPE(tra), ALLOCATABLE :: tt(:)
836	TYPE(db), ALLOCATABLE :: tdb(:)
837	LOGICAL, ALLOCATABLE :: liso(:)
838
839	!--- THE INPUT FILE MUST BE PRESENT
840	IF(test(fmsg(testFile(fnam),'Missing isotopes parameters file "'//TRIM(fnam)//'"'),lerr)) RETURN
841
842	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
843	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
844	IF(test(readSections(fnam,strStack(isot(:)%prnt,',')),lerr)) RETURN!--- Read sections, one each parent tracer
845	ndb = SIZE(dBase, DIM=1) !--- Current database size
846
847	DO idb = nb0, ndb
848	t => dBase(idb)%trac(:)
849	nt = SIZE(t) !--- Number of isotopes in the current database section
850
851	PRINT*
852	PRINT*,'AVANT:'
853	DO it=1,SIZE(t); print*,TRIM(t(it)%name)//': '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
854	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
855	CALL addKeysFromDef(dBase(idb)%trac, 'params')
856
857	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
858	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
859
860	PRINT*
861	PRINT*,'AVANT REDUCTION:'
862	t => dBase(idb)%trac(:)
863	DO it=1,SIZE(t); print*,TRIM(t(it)%name)//': '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
864
865	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS
866	DO it=1, nt
867	v => dBase(idb)%trac(it)%keys%val(:)
868	WHERE(reduceExpr(v, vals)) v = vals
869	END DO
870
871	PRINT*
872	PRINT*,'APRES:'
873	t => dBase(idb)%trac(:)
874	DO it=1,SIZE(t); print*,TRIM(t(it)%name)//': '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
875
876	!--- TRANSFER THE key=val PAIRS TO THE ISOTOPES DESCRIPTOR
877	print*
878	print*,'isot%prnt = '//strStack(isot%prnt)
879
880	ky => isot(strIdx(isot(:)%prnt, dBase(idb)%name))%keys !--- Keys of "isot" tracers with parent "dBase(idb)%name"
881	print*,'ky%name = '//strStack(ky%name)
882	is=1
883	DO it = 1, nt; IF(it == i0) CYCLE
884	print*,'AAAAAA '//strStack(ky%name)
885	print*,' '//TRIM(t(it)%name)
886	is = strIdx(ky(:)%name, t(it)%name) !--- Index of the "isot(:)" tracer named "t(it)%name"
887	IF(is == 0) CYCLE !--- Current isotope is not present in "isot" => not needed
888	k => ky(is)%key; k = t(it)%keys%key
889	v => ky(is)%val; v = t(it)%keys%val
890	WHERE(reduceExpr(v, vals)) v = vals
891	DO ik=1, SIZE(k); IF(reduceExpr(v(ik),val)) v(ik) = val; END DO!--- Reduce operations (for substituted variables)
892	print*,'(4) '//strStack([(TRIM(k(i))//'='//TRIM(v(i)), i=1, SIZE(k))])
893	END DO
894	print*,'(7) i0=',i0
895
896	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
897	liso = [( ALLOCATED(ky(is)%key), is=1, SIZE(ky) )]
898	print*,'liso=',liso
899	IF(test(checkList(ky(:)%name, &
900	.NOT.liso, 'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
901	END DO
902
903	!--- CLEAN THE DATABASE ENTRIES
904	IF(nb0 == 1) THEN
905	DEALLOCATE(dBase); ALLOCATE(dBase(0))
906	ELSE
907	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
908	END IF
909	lerr = dispIsotopes(isot,'isotopes parameters read from file')
910
911	END FUNCTION readIsotopesFile
912	!==============================================================================================================================
913
914	!==============================================================================================================================
915	LOGICAL FUNCTION dispIsotopes(ides, message) RESULT(lerr)
916	TYPE(iso), INTENT(IN) :: ides(:) !--- Isotopes descriptor vector
917	CHARACTER(LEN=*), INTENT(IN) :: message !--- Message to display
918	INTEGER :: ik, nk, ip, it, nt
919	CHARACTER(LEN=256) :: prf
920	CHARACTER(LEN=256), ALLOCATABLE :: ttl(:), val(:,:)
921	CALL msg(TRIM(message)//':')
922	DO ip = 1, SIZE(ides) !--- Loop on parents tracers
923	nk = SIZE(ides(ip)%keys(1)%key) !--- Same keys for each isotope
924	nt = SIZE(ides(ip)%keys) !--- Number of isotopes
925	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
926	ALLOCATE(ttl(nk+2), val(nt,nk+1))
927	ttl(1:2) = ['iq ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
928	val(:,1) = ides(ip)%keys(:)%name !--- Values table 1st column: isotopes names
929	DO ik = 1, nk
930	DO it = 1, nt
931	val(it,ik+1) = ides(ip)%keys(it)%val(ik) !--- Other columns: keys values
932	END DO
933	END DO
934	IF(test(fmsg(dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)'),'Problem with the table content'), lerr)) RETURN
935	DEALLOCATE(ttl, val)
936	END DO
937	END FUNCTION dispIsotopes
938	!==============================================================================================================================
939
940
941	!==============================================================================================================================
942	SUBROUTINE addKey_1(key, val, ky, lOverWrite)
943	!------------------------------------------------------------------------------------------------------------------------------
944	! Purpose: Add the <key>=<val> pair in the "ky" keys descriptor.
945	!------------------------------------------------------------------------------------------------------------------------------
946	CHARACTER(LEN=*), INTENT(IN) :: key, val
947	TYPE(kys), INTENT(INOUT) :: ky
948	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
949	CHARACTER(LEN=256), ALLOCATABLE :: k(:), v(:)
950	INTEGER :: iky, nky
951	LOGICAL :: lo
952	!------------------------------------------------------------------------------------------------------------------------------
953	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
954	iky = strIdx(ky%key,key)
955	IF(iky == 0) THEN
956	nky = SIZE(ky%key)
957	IF(nky == 0) THEN
958	ky%key = TRIM(key); ky%val = TRIM(val)
959	ELSE
960	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = TRIM(key); CALL MOVE_ALLOC(FROM=k, TO=ky%key)
961	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = TRIM(val); CALL MOVE_ALLOC(FROM=v, TO=ky%val)
962	END IF
963	ELSE IF(lo) THEN !--- Overwriting
964	ky%key(iky) = TRIM(key); ky%val(iky) = TRIM(val)
965	END IF
966	END SUBROUTINE addKey_1
967	!==============================================================================================================================
968	SUBROUTINE addKey_tra(key, val, tr, lOverWrite, tname)
969	!------------------------------------------------------------------------------------------------------------------------------
970	! Purpose: Add the <key>=<val> pair in all the components of the "tr(itr)%keys" keys descriptor:
971	! * "tname" specified: for the index "itr" of the tracer named "tname"
972	! * "tname" unspecified: for all the tracers
973	!------------------------------------------------------------------------------------------------------------------------------
974	CHARACTER(LEN=*), INTENT(IN) :: key, val
975	TYPE(tra), INTENT(INOUT) :: tr(:)
976	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
977	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname
978	INTEGER :: itr
979	LOGICAL :: lo
980	!------------------------------------------------------------------------------------------------------------------------------
981	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
982	IF(PRESENT(tname)) THEN
983	itr = strIdx(tr%name, tname)
984	IF(itr == 0) RETURN
985	CALL addKey_1(key, val, tr(itr)%keys, lo)
986	ELSE
987	DO itr = 1, SIZE(tr); CALL addKey_1(key, val, tr(itr)%keys, lo); END DO
988	END IF
989	END SUBROUTINE addKey_tra
990	!==============================================================================================================================
991	SUBROUTINE addKeysFromDef(tr, tr0)
992	USE ioipsl_getin_p_mod, ONLY : getin_p
993	TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: tr(:)
994	CHARACTER(LEN=*), INTENT(IN) :: tr0
995	CHARACTER(LEN=256) :: val
996	INTEGER :: ik, i0
997	i0 = strIdx(tr%name, tr0)
998	IF(i0 == 0) RETURN
999	DO ik = 1, SIZE(tr(i0)%keys%key)
1000	val = 'zzzz'; CALL getin_p(tr(i0)%keys%key(ik), val)
1001	IF(val /= 'zzzz') CALL addKey_1(tr(i0)%keys%key(ik), val, tr(i0)%keys, .TRUE.)
1002	END DO
1003	END SUBROUTINE addKeysFromDef
1004	!==============================================================================================================================
1005	SUBROUTINE delKey_1(itr, keyn, ky)
1006	!------------------------------------------------------------------------------------------------------------------------------
1007	! Purpose: Internal routine.
1008	! Remove <key>=<val> pairs in the "itr"th component of the "ky" keys descriptor.
1009	!------------------------------------------------------------------------------------------------------------------------------
1010	INTEGER, INTENT(IN) :: itr
1011	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1012	TYPE(tra), INTENT(INOUT) :: ky(:)
1013	CHARACTER(LEN=256), ALLOCATABLE :: k(:), v(:)
1014	LOGICAL, ALLOCATABLE :: ll(:)
1015	INTEGER :: iky
1016	!------------------------------------------------------------------------------------------------------------------------------
1017	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
1018	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
1019	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
1020	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
1021	END SUBROUTINE delKey_1
1022	!==============================================================================================================================
1023	SUBROUTINE delKey(keyn, ky)
1024	!------------------------------------------------------------------------------------------------------------------------------
1025	! Purpose: Internal routine.
1026	! Remove <key>=<val> pairs in all the components of the "t" tracers descriptor.
1027	!------------------------------------------------------------------------------------------------------------------------------
1028	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
1029	TYPE(tra), INTENT(INOUT) :: ky(:)
1030	INTEGER :: iky
1031	!------------------------------------------------------------------------------------------------------------------------------
1032	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
1033	END SUBROUTINE delKey
1034	!==============================================================================================================================
1035
1036
1037	!==============================================================================================================================
1038	!=== PUBLIC ROUTINES: GET A KEY FROM A <key>=<val> LIST ; VECTORS, TRACER AND DATABASE VERSIONS ===============================
1039	!=== BEWARE !!! IF THE "ky" ARGUMENT IS NOT PRESENT, THEN THE VARIABLES "tracers" AND "isotopes" ARE USED. ====================
1040	!=== THEY ARE LOCAL TO THIS MODULE, SO MUST MUST BE INITIALIZED FIRST USING the "getKey_init" ROUTINE ====================
1041	!==============================================================================================================================
1042	SUBROUTINE getKey_init(tracers_, isotopes_)
1043	TYPE(tra), OPTIONAL, INTENT(IN) :: tracers_(:)
1044	TYPE(iso), OPTIONAL, INTENT(IN) :: isotopes_(:)
1045	IF(PRESENT( tracers_)) tracers = tracers_
1046	IF(PRESENT(isotopes_)) isotopes = isotopes_
1047	END SUBROUTINE getKey_init
1048	!==============================================================================================================================
1049	CHARACTER(LEN=256) FUNCTION fgetKey(itr, keyn, ky, def_val) RESULT(out)
1050	!------------------------------------------------------------------------------------------------------------------------------
1051	! Purpose: Internal function ; get a key value in string format (this is the returned argument).
1052	!------------------------------------------------------------------------------------------------------------------------------
1053	INTEGER, INTENT(IN) :: itr
1054	CHARACTER(LEN=*), INTENT(IN) :: keyn
1055	TYPE(kys), INTENT(IN) :: ky(:)
1056	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
1057	!------------------------------------------------------------------------------------------------------------------------------
1058	INTEGER :: ik
1059	ik = 0; IF(itr>0 .AND. itr<=SIZE(ky)) ik = strIdx(ky(itr)%key(:), keyn)
1060	out = ''; IF(ik /= 0) out = ky(itr)%val(ik) !--- Key was found
1061	IF(PRESENT(def_val) .AND. ik == 0) out = def_val !--- Default value from arguments
1062	END FUNCTION fgetKey
1063	!==============================================================================================================================
1064	LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
1065	!--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".
1066	! * "ky" unspecified: try in "tracers" for "tnam" with phase suffix, then in "isotopes" without.
1067	! * "ky" specified: try in "ky" for "tnam" with, then without phase suffix.
1068	! The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.
1069	CHARACTER(LEN=*), INTENT(IN) :: keyn
1070	CHARACTER(LEN=256), INTENT(OUT) :: val
1071	CHARACTER(LEN=*), INTENT(IN) :: tname
1072	TYPE(kys), OPTIONAL, INTENT(IN) :: ky(:)
1073	INTEGER :: is
1074	lerr = .FALSE.
1075	IF(PRESENT(ky)) THEN
1076	val = getKeyByName_prv(keyn, tname , ky); IF(val /= '') RETURN !--- "ky" and "tnam"
1077	val = getKeyByName_prv(keyn, delPhase(tname), ky) !--- "ky" and "tnam" without phase
1078	ELSE
1079	IF(.NOT.ALLOCATED(tracers)) RETURN
1080	val = getKeyByName_prv(keyn, tname, tracers(:)%keys); IF(val /= '') RETURN !--- "tracers" and "tnam"
1081	IF(.NOT.ALLOCATED(isotopes)) RETURN
1082	IF(SIZE(isotopes) == 0) RETURN
1083	DO is = 1, SIZE(isotopes); IF(strIdx(isotopes(is)%keys(:)%name, tname) /= 0) EXIT; END DO
1084	IF(is /= 0) val = getKeyByName_prv(keyn, tname, isotopes(is)%keys(:)) !--- "isotopes" and "tnam" without phase
1085	END IF
1086
1087	CONTAINS
1088
1089	FUNCTION getKeyByName_prv(keyn, tname, ky) RESULT(val)
1090	CHARACTER(LEN=256) :: val
1091	CHARACTER(LEN=*), INTENT(IN) :: keyn
1092	CHARACTER(LEN=*), INTENT(IN) :: tname
1093	TYPE(kys), INTENT(IN) :: ky(:)
1094	INTEGER :: itr, iky
1095	val = ''; iky = 0
1096	itr = strIdx(ky(:)%name, tname); IF(itr==0) RETURN !--- Get the index of the wanted tracer
1097	IF(itr /= 0) iky = strIdx(ky(itr)%key(:), keyn); IF(iky==0) RETURN !--- Wanted key index
1098	val = ky(itr)%val(iky)
1099	END FUNCTION getKeyByName_prv
1100
1101	END FUNCTION getKeyByName_s1
1102	!==============================================================================================================================
1103	LOGICAL FUNCTION getKeyByName_sm(keyn, val, tnam, ky) RESULT(lerr)
1104	CHARACTER(LEN=*), INTENT(IN) :: keyn
1105	CHARACTER(LEN=256), ALLOCATABLE, INTENT(OUT) :: val(:)
1106	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
1107	TYPE(kys), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
1108	CHARACTER(LEN=256), POINTER :: n(:)
1109	INTEGER :: iq
1110	n => tracers(:)%keys%name; IF(PRESENT(tnam)) n => tnam(:)
1111	ALLOCATE(val(SIZE(n)))
1112	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
1113	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq)), iq=1, SIZE(n))])
1114	END FUNCTION getKeyByName_sm
1115	!==============================================================================================================================
1116	LOGICAL FUNCTION getKeyByName_i1(keyn, val, tnam, ky) RESULT(lerr)
1117	CHARACTER(LEN=*), INTENT(IN) :: keyn
1118	INTEGER, INTENT(OUT) :: val
1119	CHARACTER(LEN=*), INTENT(IN) :: tnam
1120	TYPE(kys), OPTIONAL, INTENT(IN) :: ky(:)
1121	CHARACTER(LEN=256) :: sval
1122	INTEGER :: ierr
1123	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
1124	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
1125	IF(test(fmsg(lerr, 'key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing'), lerr)) RETURN
1126	READ(sval, *, IOSTAT=ierr) val
1127	IF(test(fmsg(ierr/=0,'key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not an integer'), lerr)) RETURN
1128	END FUNCTION getKeyByName_i1
1129	!==============================================================================================================================
1130	LOGICAL FUNCTION getKeyByName_im(keyn, val, tnam, ky) RESULT(lerr)
1131	CHARACTER(LEN=*), INTENT(IN) :: keyn
1132	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
1133	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
1134	TYPE(kys), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
1135	CHARACTER(LEN=256), POINTER :: n(:)
1136	INTEGER :: iq
1137	n => tracers(:)%name; IF(PRESENT(tnam)) n => tnam(:)
1138	ALLOCATE(val(SIZE(n)))
1139	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
1140	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq)), iq=1, SIZE(n))])
1141	END FUNCTION getKeyByName_im
1142	!==============================================================================================================================
1143	LOGICAL FUNCTION getKeyByName_r1(keyn, val, tnam, ky) RESULT(lerr)
1144	CHARACTER(LEN=*), INTENT(IN) :: keyn
1145	REAL, INTENT(OUT) :: val
1146	CHARACTER(LEN=*), INTENT(IN) :: tnam
1147	TYPE(kys), OPTIONAL, INTENT(IN) :: ky(:)
1148	CHARACTER(LEN=256) :: sval
1149	INTEGER :: ierr
1150	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
1151	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
1152	IF(test(fmsg(lerr, 'key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing'), lerr)) RETURN
1153	READ(sval, *, IOSTAT=ierr) val
1154	IF(test(fmsg(ierr/=0,'key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not a real'), lerr)) RETURN
1155	END FUNCTION getKeyByName_r1
1156	!==============================================================================================================================
1157	LOGICAL FUNCTION getKeyByName_rm(keyn, val, tnam, ky) RESULT(lerr)
1158	CHARACTER(LEN=*), INTENT(IN) :: keyn
1159	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
1160	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
1161	TYPE(kys), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
1162	CHARACTER(LEN=256), POINTER :: n(:)
1163	INTEGER :: iq
1164	n => tracers(:)%name; IF(PRESENT(tnam)) n => tnam(:)
1165	ALLOCATE(val(SIZE(n)))
1166	IF( PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
1167	IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq)), iq=1, SIZE(n))])
1168	END FUNCTION getKeyByName_rm
1169	!==============================================================================================================================
1170
1171
1172	!==============================================================================================================================
1173	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
1174	!==============================================================================================================================
1175	ELEMENTAL CHARACTER(LEN=256) FUNCTION delPhase(s) RESULT(out)
1176	CHARACTER(LEN=*), INTENT(IN) :: s
1177	INTEGER :: l
1178	out = s
1179	IF(s == '') RETURN
1180	l=LEN_TRIM(s)
1181	IF(s(l-1:l-1)=='-' .AND. INDEX(known_phases,s(l:l))/=0) out = s(1:l-2)
1182	END FUNCTION delPhase
1183	!------------------------------------------------------------------------------------------------------------------------------
1184	CHARACTER(LEN=256) FUNCTION addPhase_1(s,pha) RESULT(out)
1185	CHARACTER(LEN=*), INTENT(IN) :: s
1186	CHARACTER(LEN=1), INTENT(IN) :: pha
1187	IF(INDEX(s,'_')==0) THEN; out = TRIM(s)//'-'//pha; RETURN; END IF
1188	out = TRIM(strHead(s,'_'))//'-'//pha//TRIM(strTail(s,'_'))
1189	END FUNCTION addPhase_1
1190	!------------------------------------------------------------------------------------------------------------------------------
1191	FUNCTION addPhase_m(s,pha) RESULT(out)
1192	CHARACTER(LEN=*), INTENT(IN) :: s(:)
1193	CHARACTER(LEN=1), INTENT(IN) :: pha
1194	CHARACTER(LEN=256), ALLOCATABLE :: out(:)
1195	INTEGER :: k
1196	out = [( addPhase_1(s(k), pha), k=1, SIZE(s) )]
1197	END FUNCTION addPhase_m
1198	!------------------------------------------------------------------------------------------------------------------------------
1199
1200
1201	!==============================================================================================================================
1202	!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =======
1203	!==============================================================================================================================
1204	CHARACTER(LEN=256) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
1205	TYPE(tra), INTENT(IN) :: t(:)
1206	CHARACTER(LEN=*), INTENT(IN) :: tname
1207	INTEGER, OPTIONAL, INTENT(IN) :: igen
1208	INTEGER :: ig, ix
1209	ig = 1; IF(PRESENT(igen)) ig = igen
1210	ix = idxAncestor_1(t, tname, ig)
1211	out = ''; IF(ix /= 0) out = t(ix)%name
1212	END FUNCTION ancestor_1
1213	!------------------------------------------------------------------------------------------------------------------------------
1214	FUNCTION ancestor_m(t, tname, igen) RESULT(out)
1215	CHARACTER(LEN=256), ALLOCATABLE :: out(:)
1216	TYPE(tra), INTENT(IN) :: t(:)
1217	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1218	INTEGER, OPTIONAL, INTENT(IN) :: igen
1219	INTEGER, ALLOCATABLE :: ix(:)
1220	INTEGER :: ig
1221	ig = 1; IF(PRESENT(igen)) ig = igen
1222	IF( PRESENT(tname)) ix = idxAncestor_m(t, tname, ig)
1223	IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
1224	ALLOCATE(out(SIZE(ix))); out(:) = ''
1225	WHERE(ix /= 0) out = t(ix)%name
1226	END FUNCTION ancestor_m
1227	!==============================================================================================================================
1228
1229
1230	!==============================================================================================================================
1231	!=== GET THE INDEX(ES) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =====
1232	!==============================================================================================================================
1233	INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
1234	! Return the name of the generation "igen" ancestor of "tname"
1235	TYPE(tra), INTENT(IN) :: t(:)
1236	CHARACTER(LEN=*), INTENT(IN) :: tname
1237	INTEGER, OPTIONAL, INTENT(IN) :: igen
1238	INTEGER :: ig
1239	ig = 1; IF(PRESENT(igen)) ig = igen
1240	out = strIdx(t(:)%name, tname)
1241	IF(out == 0) RETURN
1242	IF(t(out)%igen <= ig) RETURN
1243	DO WHILE(t(out)%igen > ig); out = strIdx(t(:)%name, t(out)%prnt); END DO
1244	END FUNCTION idxAncestor_1
1245	!------------------------------------------------------------------------------------------------------------------------------
1246	FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
1247	INTEGER, ALLOCATABLE :: out(:)
1248	TYPE(tra), INTENT(IN) :: t(:)
1249	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
1250	INTEGER, OPTIONAL, INTENT(IN) :: igen
1251	INTEGER :: ig, ix
1252	ig = 1; IF(PRESENT(igen)) ig = igen
1253	IF( PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix), ig), ix=1, SIZE(tname))]
1254	IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
1255	END FUNCTION idxAncestor_m
1256	!==============================================================================================================================
1257
1258
1259	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format