Context Navigation

readTracFiles_mod.f90 @ 4358

Last change on this file since 4358 was 4358, checked in by dcugnet, 19 months ago

remove "config_inca" variable from "control_mod" and "infotrac_phy" (read in infotrac)
only kept version of "type_trac" is in tracinca ; few tests are moved from infotrac to this module.
simplify and generalize a bit the routines "phyetat0_get" and "phyetat0_srf" from phyetat0, converted to a module.
fix the isotopic version: few "USE … » were misplaced between ISOVERIF CPP keys
fix the old water and derived isotopes names in the ISOTRAC case

File size: 130.4 KB

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

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

Download in other formats:

Original Format