Context Navigation

readTracFiles_mod.f90 @ 4419

Last change on this file since 4419 was 4403, checked in by dcugnet, 17 months ago
fix for isotopic tagging tracers modify strHead/strTail: last argument (optional) has the same convention as INDEX: if lBackward==.TRUE., search the pattern starting from the end of the string (default=.FALSE.) consolidate and simplify the new2oldH2O routine
File size: 129.3 KB

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

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

Download in other formats:

Original Format