Head

GCC Code Coverage Report

Directory:	./		Exec	Total	Coverage
File:	misc/readTracFiles_mod.f90	Lines:	382	832	45.9 %
Date:	2023-06-30 12:51:15	Branches:	881	4070	21.6 %

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


Generated by: GCOVR (Version 4.2)