Context Navigation

lmdz_readTracFiles.f90 @ 5204

Last change on this file since 5204 was 5122, checked in by abarral, 4 months ago
fix lmdz_fxy
File size: 176.2 KB

Rev	Line
[5117]	1	MODULE lmdz_readTracFiles
[4046]	2
[5117]	3	USE lmdz_strings, ONLY: msg, find, get_in, dispTable, strHead, strReduce, strFind, strStack, strIdx, &
	4	removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
	5	int2str, str2int, real2str, str2real, bool2str, str2bool
[4046]	6
[5117]	7	IMPLICIT NONE; PRIVATE
[4046]	8
[4325]	9	PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH
[4987]	10	PUBLIC :: trac_type, tracers, setGeneration, indexUpdate !--- TRACERS DESCRIPTION DATABASE + ASSOCIATED TOOLS
[4325]	11	PUBLIC :: testTracersFiles, readTracersFiles !--- TRACERS FILES READING ROUTINES
[4987]	12	PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
	13	PUBLIC :: addTracer, delTracer !--- ADD/REMOVE A TRACER FROM
[5117]	14	PUBLIC :: addKey, delKey, getKey, keys_type !--- TOOLS TO SET/DEL/GET KEYS FROM/TO tracers & isotopes
	15	PUBLIC :: addPhase, delPhase, getPhase, getiPhase, & !--- FUNCTIONS RELATED TO THE PHASES
	16	nphases, old_phases, phases_sep, known_phases, phases_names !--- + ASSOCIATED VARIABLES
[4046]	17
[4325]	18	PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
[5117]	19	PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc)
[4120]	20
[5001]	21	PUBLIC :: tran0 !--- TRANSPORTING FLUID (USUALLY air)
[4301]	22
	23	!=== FOR ISOTOPES: GENERAL
[5001]	24	PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
[4301]	25
[4325]	26	!=== FOR ISOTOPES: H2O FAMILY ONLY
	27	PUBLIC :: iH2O
	28
	29	!=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
	30	PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
	31	PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
[5117]	32	PUBLIC :: niso, nzone, nphas, ntiso !--- " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
[4325]	33	PUBLIC :: itZonIso !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
	34	PUBLIC :: iqIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx)
[4984]	35	PUBLIC :: iqWIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx) but with normal water first
[4325]	36	PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
	37
[4193]	38	PUBLIC :: maxTableWidth
[5117]	39	!------------------------------------------------------------------------------------------------------------------------------
[4987]	40	TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
[5117]	41	CHARACTER(LEN = maxlen) :: name !--- Tracer name
	42	CHARACTER(LEN = maxlen), ALLOCATABLE :: key(:) !--- Keys string list
	43	CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:) !--- Corresponding values string list
[4325]	44	END TYPE keys_type
[5117]	45	!------------------------------------------------------------------------------------------------------------------------------
[4987]	46	TYPE :: trac_type !=== TYPE FOR A SINGLE TRACER NAMED "name"
[5117]	47	CHARACTER(LEN = maxlen) :: name = '' !--- Name of the tracer
	48	TYPE(keys_type) :: keys !--- <key>=<val> pairs vector
	49	CHARACTER(LEN = maxlen) :: gen0Name = '' !--- First generation ancestor name
	50	CHARACTER(LEN = maxlen) :: parent = '' !--- Parent name
	51	CHARACTER(LEN = maxlen) :: longName = '' !--- Long name (with advection scheme suffix)
	52	CHARACTER(LEN = maxlen) :: type = 'tracer' !--- Type (so far: 'tracer' / 'tag')
	53	CHARACTER(LEN = maxlen) :: phase = 'g' !--- Phase ('g'as / 'l'iquid / 's'olid)
	54	CHARACTER(LEN = maxlen) :: component = '' !--- Coma-separated list of components (Ex: lmdz,inca)
	55	INTEGER :: iGeneration = -1 !--- Generation number (>=0)
	56	INTEGER :: iqParent = 0 !--- Parent index
	57	INTEGER, ALLOCATABLE :: iqDescen(:) !--- Descendants index (in growing generation order)
	58	INTEGER :: nqDescen = 0 !--- Number of descendants (all generations)
	59	INTEGER :: nqChildren = 0 !--- Number of children (first generation)
	60	INTEGER :: iadv = 10 !--- Advection scheme used
	61	LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue
	62	LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
	63	INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:)
	64	INTEGER :: iso_iName = 0 !--- Isotope name index in isotopes(iso_iGroup)%trac(:)
	65	INTEGER :: iso_iZone = 0 !--- Isotope zone index in isotopes(iso_iGroup)%zone(:)
	66	INTEGER :: iso_iPhase = 0 !--- Isotope phase index in isotopes(iso_iGroup)%phase
[4325]	67	END TYPE trac_type
[5117]	68	!------------------------------------------------------------------------------------------------------------------------------
[4987]	69	TYPE :: isot_type !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
[5117]	70	CHARACTER(LEN = maxlen) :: parent !--- Isotopes family name (parent tracer name ; ex: H2O)
	71	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
	72	LOGICAL :: check = .FALSE. !--- Flag for checking routines triggering
	73	CHARACTER(LEN = maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
	74	CHARACTER(LEN = maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
	75	CHARACTER(LEN = maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas)
	76	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
	77	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
	78	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
	79	INTEGER :: nphas = 0 !--- Number of phases
	80	INTEGER, ALLOCATABLE :: iqIsoPha(:, :) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
	81	!--- (former name: "iqiso"
	82	INTEGER, ALLOCATABLE :: iqWIsoPha(:, :) !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
	83	INTEGER, ALLOCATABLE :: itZonIso(:, :) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
[4987]	84	END TYPE isot_type !--- (former name: "index_trac")
[5117]	85	!------------------------------------------------------------------------------------------------------------------------------
[4325]	86	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
[5117]	87	CHARACTER(LEN = maxlen) :: name !--- Section name
[4325]	88	TYPE(trac_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
[4046]	89	END TYPE dataBase_type
[5117]	90	!------------------------------------------------------------------------------------------------------------------------------
[4046]	91	INTERFACE getKey
[5001]	92	MODULE PROCEDURE &
[5117]	93	getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
	94	getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
	95	getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
	96	getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
	97	getKeyByName_s111, getKeyByName_sm11, getKeyByName_s1m1, getKeyByName_smm1, getKeyByName_s1mm, getKeyByName_smmm, &
	98	getKeyByName_i111, getKeyByName_im11, getKeyByName_i1m1, getKeyByName_imm1, getKeyByName_i1mm, getKeyByName_immm, &
	99	getKeyByName_r111, getKeyByName_rm11, getKeyByName_r1m1, getKeyByName_rmm1, getKeyByName_r1mm, getKeyByName_rmmm, &
	100	getKeyByName_l111, getKeyByName_lm11, getKeyByName_l1m1, getKeyByName_lmm1, getKeyByName_l1mm, getKeyByName_lmmm
[4046]	101	END INTERFACE getKey
[5117]	102	!------------------------------------------------------------------------------------------------------------------------------
[4987]	103	INTERFACE addKey
	104	MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
[5117]	105	addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
[4987]	106	END INTERFACE addKey
[5117]	107	!------------------------------------------------------------------------------------------------------------------------------
	108	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
	109	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
	110	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
[5001]	111	INTERFACE addTracer; MODULE PROCEDURE addTracer_1, addTracer_1def; END INTERFACE addTracer
	112	INTERFACE delTracer; MODULE PROCEDURE delTracer_1, delTracer_1def; END INTERFACE delTracer
[5117]	113	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
	114	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
	115	!------------------------------------------------------------------------------------------------------------------------------
[4046]	116
	117	!=== MAIN DATABASE: files sections descriptors
	118	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
	119
	120	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
[5117]	121	CHARACTER(LEN = maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
	122	CHARACTER(LEN = maxlen), PARAMETER :: old_phases = 'vlirb' !--- Old phases for water (no separator)
	123	CHARACTER(LEN = maxlen), PARAMETER :: known_phases = 'glsrb' !--- Known phases initials
[4301]	124	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
[5117]	125	CHARACTER(LEN = maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
	126	= ['gaseous ', 'liquid ', 'solid ', 'cloud ', 'blownSnow']
	127	CHARACTER(LEN = 1), SAVE :: phases_sep = '_' !--- Phase separator
	128	CHARACTER(LEN = maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
[4046]	129
[4301]	130	!--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
[5117]	131	CHARACTER(LEN = maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ]
	132	CHARACTER(LEN = maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO ', 'H218O', 'H217O', 'HTO ']
[4120]	133
[4987]	134	!--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
[5117]	135	CHARACTER(LEN = maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 ']
	136	CHARACTER(LEN = maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot']
[4301]	137
[4325]	138	!=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
[5117]	139	TYPE(trac_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
[4046]	140	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
	141
[4325]	142	!=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
[5117]	143	TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
	144	INTEGER, SAVE :: ixIso, iH2O = 0 !--- Index of the selected isotopes family and H2O family
	145	INTEGER, SAVE :: nbIso !--- Number of isotopes classes
	146	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
	147	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
	148	CHARACTER(LEN = maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
	149	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
	150	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
	151	INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
	152	nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
	153	INTEGER, SAVE, POINTER :: itZonIso(:, :), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx)
	154	iqIsoPha(:, :), & !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
	155	iqWIsoPha(:, :) !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
[4325]	156
[4987]	157	!=== PARAMETERS FOR DEFAULT BEHAVIOUR
	158	LOGICAL, PARAMETER :: lTracsMerge = .FALSE. !--- Merge/stack tracers lists
[5117]	159	LOGICAL, PARAMETER :: lSortByGen = .TRUE. !--- Sort by growing generation
[4987]	160
[5117]	161	INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"
	162	CHARACTER(LEN = maxlen) :: modname
[4046]	163
	164	CONTAINS
	165
[5117]	166	!==============================================================================================================================
	167	!==============================================================================================================================
	168	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
	169	!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
	170	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
	171	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
	172	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
	173	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
	174	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
	175	!=== REMARKS:
	176	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
	177	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
	178	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
	179	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
	180	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
	181	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
	182	!=== ABOUT THE KEYS:
	183	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
	184	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
	185	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
	186	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
	187	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
	188	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
	189	!==============================================================================================================================
	190	LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
	191	!------------------------------------------------------------------------------------------------------------------------------
	192	CHARACTER(LEN = *), INTENT(IN) :: type_trac !--- List of components used
	193	TYPE(trac_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:) !--- Tracers descriptor for external storage
	194	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNO3 exceptions for REPROBUS
	195	CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
	196	CHARACTER(LEN = maxlen) :: str, fname, tname, pname, cname
	197	INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
	198	INTEGER, ALLOCATABLE :: iGen(:)
	199	LOGICAL :: lRep
	200	TYPE(keys_type), POINTER :: k
	201	!------------------------------------------------------------------------------------------------------------------------------
	202	lerr = .FALSE.
	203	modname = 'readTracersFiles'
	204	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
	205	lRep = .FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
[4046]	206
[5117]	207	!--- Required sections + corresponding files names (new style single section case) for tests
	208	lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
	209	nsec = SIZE(sections)
[4046]	210
[5117]	211	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	212	SELECT CASE(fType) !--- Set name, component, parent, phase, iGeneration, gen0Name, type
	213	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4301]	214	CASE(1) !=== OLD FORMAT "traceur.def"
[5117]	215	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	216	!--- OPEN THE "traceur.def" FILE
[5117]	217	OPEN(90, FILE = "traceur.def", FORM = 'formatted', STATUS = 'old', POSITION = 'REWIND', IOSTAT = ierr)
[4046]	218
[4063]	219	!--- GET THE TRACERS NUMBER
[5117]	220	READ(90, '(i3)', IOSTAT = ierr)ntrac !--- Number of lines/tracers
	221	lerr = ierr/=0; IF(fmsg('Invalid format for "' // TRIM(fname) // '"', modname, lerr)) RETURN
[4046]	222
[4063]	223	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
[4325]	224	ALLOCATE(tracers(ntrac))
[5001]	225	DO it = 1, ntrac !=== READ RAW DATA: loop on the line/tracer number
[5117]	226	READ(90, '(a)', IOSTAT = ierr) str
	227	lerr = ierr>0; IF(fmsg('Invalid format for "' // TRIM(fname) // '"', modname, lerr)) RETURN
	228	lerr = ierr<0; IF(fmsg('Not enough lines in "' // TRIM(fname) // '"', modname, lerr)) RETURN
[4348]	229	lerr = strParse(str, ' ', s, ns)
[5117]	230	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
[4063]	231	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
[4325]	232	k => tracers(it)%keys
[4301]	233
	234	!=== NAME OF THE TRACER
	235	tname = old2newH2O(s(3), ip)
	236	ix = strIdx(oldHNO3, s(3))
	237	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
[5001]	238	tracers(it)%name = tname !--- Set the name of the tracer
	239	CALL addKey('name', tname, k) !--- Set the name of the tracer
[4325]	240	tracers(it)%keys%name = tname !--- Copy tracers names in keys components
[4301]	241
	242	!=== NAME OF THE COMPONENT
	243	cname = type_trac !--- Name of the model component
	244	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
[5001]	245	tracers(it)%component = cname !--- Set component
	246	CALL addKey('component', cname, k) !--- Set the name of the model component
[4301]	247
	248	!=== NAME OF THE PARENT
	249	pname = tran0 !--- Default name: default transporting fluid (air)
	250	IF(ns == 4) THEN
	251	pname = old2newH2O(s(4))
	252	ix = strIdx(oldHNO3, s(4))
	253	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
	254	END IF
[5001]	255	tracers(it)%parent = pname !--- Set the parent name
	256	CALL addKey('parent', pname, k)
[4301]	257
	258	!=== PHASE AND ADVECTION SCHEMES NUMBERS
[5001]	259	tracers(it)%phase = known_phases(ip:ip) !--- Set the phase of the tracer (default: "g"azeous)
	260	CALL addKey('phase', known_phases(ip:ip), k) !--- Set the phase of the tracer (default: "g"azeous)
[5117]	261	CALL addKey('hadv', s(1), k) !--- Set the horizontal advection schemes number
	262	CALL addKey('vadv', s(2), k) !--- Set the vertical advection schemes number
[4063]	263	END DO
	264	CLOSE(90)
[5001]	265	lerr = setGeneration(tracers); IF(lerr) RETURN !--- Set iGeneration and gen0Name
	266	lerr = getKey('iGeneration', iGen, tracers(:)%keys) !--- Generation number
	267	WHERE(iGen == 2) tracers(:)%type = 'tag' !--- Set type: 'tracer' or 'tag'
[5005]	268	DO it = 1, ntrac
	269	CALL addKey('type', tracers(it)%type, tracers(it)%keys) !--- Set the type of tracer
	270	END DO
[5001]	271	lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN !--- Detect orphans and check phases
	272	lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN !--- Detect repeated tracers
	273	CALL sortTracers (tracers) !--- Sort the tracers
[5117]	274	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	275	CASE(2); lerr = feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
[4063]	276	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[5117]	277	CASE(3); lerr = feedDBase(trac_files, sections, modname); IF(lerr) RETURN !=== MULTIPLE FILES, SINGLE SECTION
	278	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	279	END SELECT
	280	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	281	IF(ALL([2, 3] /= fType)) RETURN
	282	IF(nsec == 1) tracers = dBase(1)%trac
	283	IF(nsec /= 1) THEN
	284	CALL msg('Multiple sections are MERGED', modname, lTracsMerge)
	285	CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
	286	IF(lTracsMerge) lerr = cumulTracers(dBase, tracers)
	287	IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
	288	IF(lerr) RETURN
	289	END IF
	290	lerr = indexUpdate(tracers); IF(lerr) RETURN !--- Set iqParent, iqDescen, nqDescen, nqChildren
	291	IF(PRESENT(tracs)) CALL MOVE_ALLOC(FROM = tracers, TO = tracs)
	292	END FUNCTION readTracersFiles
	293	!==============================================================================================================================
[4046]	294
[4325]	295
[5117]	296	!==============================================================================================================================
	297	LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
	298	CHARACTER(LEN = *), INTENT(IN) :: modname, type_trac
	299	INTEGER, INTENT(OUT) :: fType
	300	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	301	CHARACTER(LEN = maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
	302	CHARACTER(LEN = maxlen), ALLOCATABLE :: trac_files(:), sections(:)
	303	LOGICAL, ALLOCATABLE :: ll(:)
	304	LOGICAL :: lD, lFound
	305	INTEGER :: is, nsec
	306	lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
	307	lerr = .FALSE.
[4325]	308
[5117]	309	!--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
	310	!--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
	311	lerr = strParse(type_trac, '\|', sections, n = nsec); IF(lerr) RETURN !--- Parse "type_trac" list
	312	IF(PRESENT(sects)) sects = sections
	313	ALLOCATE(trac_files(nsec), ll(nsec))
	314	DO is = 1, nsec
	315	trac_files(is) = 'tracer_' // TRIM(sections(is)) // '.def'
	316	INQUIRE(FILE = TRIM(trac_files(is)), EXIST = ll(is))
	317	END DO
	318	IF(PRESENT(tracf)) tracf = trac_files
	319	fType = 0
	320	INQUIRE(FILE = 'traceur.def', EXIST = lFound); IF(lFound) fType = 1 !--- OLD STYLE FILE
	321	INQUIRE(FILE = 'tracer.def', EXIST = lFound); IF(lFound) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
	322	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
	323	IF(.NOT.lD) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
	324	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
	325	lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
	326	END IF
[4325]	327
[5117]	328	!--- TELLS WHAT WAS IS ABOUT TO BE USED
	329	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
	330	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
	331	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
	332	END FUNCTION testTracersFiles
	333	!==============================================================================================================================
[4325]	334
[5117]	335	!==============================================================================================================================
	336	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
	337	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
	338	! file and create the corresponding tracers set descriptors in the database "dBase":
	339	! * dBase(id)%name : section name
	340	! * dBase(id)%trac(:)%name : tracers names
	341	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
	342	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
	343	!------------------------------------------------------------------------------------------------------------------------------
	344	CHARACTER(LEN = *), INTENT(IN) :: fnames(:) !--- Files names
	345	CHARACTER(LEN = *), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
	346	CHARACTER(LEN = *), INTENT(IN) :: modname !--- Calling routine name
	347	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
	348	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
	349	CHARACTER(LEN = maxlen) :: fnm, snm
	350	INTEGER :: idb, i
	351	LOGICAL :: ll
	352	!------------------------------------------------------------------------------------------------------------------------------
	353	!=== READ THE REQUIRED SECTIONS
	354	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
	355	ALLOCATE(ixf(SUM(ndb)))
	356	DO i = 1, SIZE(fnames) !--- Set name, keys
	357	lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
	358	ixf(1 + SUM(ndb(1:i - 1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
	359	END DO
	360	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	361	DO idb = 1, SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
	362	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	363	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
	364	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "' // TRIM(snm) // '"', snm, modname), idb = 1, SIZE(dBase))])
	365	lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ; SET parent, type, component
	366	lerr = setGeneration(dBase(idb)%trac); IF(lerr) RETURN !--- SET iGeneration, genOName
	367	lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
	368	lerr = checkUnique (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
	369	lerr = expandPhases (dBase(idb)%trac); IF(lerr) RETURN !--- EXPAND PHASES ; set phase
	370	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
	371	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "' // TRIM(snm) // '"', snm, modname), idb = 1, SIZE(dBase))])
	372	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	373	END DO
	374	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	375	END FUNCTION feedDBase
	376	!------------------------------------------------------------------------------------------------------------------------------
[4046]	377
[5117]	378	!------------------------------------------------------------------------------------------------------------------------------
	379	LOGICAL FUNCTION readSections(fnam, snam, defName) RESULT(lerr)
	380	!------------------------------------------------------------------------------------------------------------------------------
	381	CHARACTER(LEN = *), INTENT(IN) :: fnam !--- File name
	382	CHARACTER(LEN = *), INTENT(IN) :: snam !--- Pipe-separated sections list
	383	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
	384	!------------------------------------------------------------------------------------------------------------------------------
	385	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	386	CHARACTER(LEN = maxlen), ALLOCATABLE :: sec(:)
	387	INTEGER, ALLOCATABLE :: ix(:)
	388	INTEGER :: n0, idb, ndb
	389	LOGICAL :: ll
	390	!------------------------------------------------------------------------------------------------------------------------------
	391	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
	392	CALL readSections_all() !--- Read all the sections of file "fnam"
	393	ndb = SIZE(dBase) !--- Current number of sections in the database
	394	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
	395	DO idb = n0, ndb; CALL addDefault(dBase(idb)%trac, defName);
	396	END DO !--- and remove the virtual tracer "defName"
	397	END IF
	398	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
	399	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
	400	lerr = checkList(sec, ix == 0, 'In file "' // TRIM(fnam) // '"', 'section(s)', 'missing'); IF(lerr) RETURN
	401	tdb = dBase(:); dBase = [tdb(1:n0 - 1), tdb(PACK(ix, MASK = ix/=0))] !--- Keep requested sections only
[4046]	402
[5117]	403	CONTAINS
[4046]	404
[5117]	405	!------------------------------------------------------------------------------------------------------------------------------
	406	SUBROUTINE readSections_all()
	407	!------------------------------------------------------------------------------------------------------------------------------
	408	CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:), v(:)
	409	TYPE(trac_type), ALLOCATABLE :: tt(:)
	410	TYPE(trac_type) :: tmp
	411	CHARACTER(LEN = 1024) :: str, str2
	412	CHARACTER(LEN = maxlen) :: secn
	413	INTEGER :: ierr, n
	414	!------------------------------------------------------------------------------------------------------------------------------
	415	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
	416	OPEN(90, FILE = fnam, FORM = 'formatted', POSITION = 'REWIND', STATUS = 'old')
	417	DO; str = ''
	418	DO
	419	READ(90, '(a)', IOSTAT = ierr)str2 !--- Read a full line
	420	str = TRIM(str) // ' ' // TRIM(str2) !--- Append "str" with the current line
	421	n = LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
	422	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
	423	str = str(1:n - 1) !--- Remove the "\" continuing line symbol
	424	END DO
	425	str = ADJUSTL(str) !--- Remove the front space
	426	IF(ierr /= 0) EXIT !--- Finished: error or end of file
	427	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
	428	CALL removeComment(str) !--- Skip comments at the end of a line
	429	IF(LEN_TRIM(str) == 0) CYCLE !--- Empty line (probably end of file)
	430	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
[5122]	431	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
[5117]	432	ndb = SIZE(dBase) !--- Number of sections so far
	433	secn = str(2:LEN_TRIM(str)) // ' ' !--- Current section name
	434	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
	435	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
	436	ndb = ndb + 1 !--- Extend database
	437	ALLOCATE(tdb(ndb))
	438	tdb(1:ndb - 1) = dBase
	439	tdb(ndb)%name = secn
	440	ALLOCATE(tdb(ndb)%trac(0))
	441	CALL MOVE_ALLOC(FROM = tdb, TO = dBase)
	442	ELSE !=== TRACER LINE
	443	ll = strParse(str, ' ', s, n, v) !--- Parse <key>=<val> pairs
	444	tt = dBase(ndb)%trac(:)
	445	v(1) = s(1); s(1) = 'name' !--- Convert "name" into a regular key
	446	tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:)) !--- Set %name and %keys
	447	dBase(ndb)%trac = [tt(:), tmp]
	448	DEALLOCATE(tt, tmp%keys%key, tmp%keys%val)
	449	END IF
	450	END DO
	451	CLOSE(90)
[4046]	452
[5117]	453	END SUBROUTINE readSections_all
	454	!------------------------------------------------------------------------------------------------------------------------------
[4046]	455
[5117]	456	END FUNCTION readSections
	457	!==============================================================================================================================
[4046]	458
	459
[5117]	460	!==============================================================================================================================
	461	SUBROUTINE addDefault(t, defName)
	462	!------------------------------------------------------------------------------------------------------------------------------
	463	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	464	!------------------------------------------------------------------------------------------------------------------------------
	465	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	466	CHARACTER(LEN = *), INTENT(IN) :: defName
	467	INTEGER :: jd, it, k
	468	TYPE(keys_type), POINTER :: ky
	469	TYPE(trac_type), ALLOCATABLE :: tt(:)
	470	jd = strIdx(t(:)%name, defName)
	471	IF(jd == 0) RETURN
	472	ky => t(jd)%keys
	473	DO k = 1, SIZE(ky%key) !--- Loop on the keys of the tracer named "defName"
	474	! CALL addKey(ky%key(k), ky%val(k), t(:)%keys, .FALSE.) !--- Add key to all the tracers (no overwriting)
	475	DO it = 1, SIZE(t); CALL addKey(ky%key(k), ky%val(k), t(it)%keys, .FALSE.);
	476	END DO
	477	END DO
	478	tt = [t(1:jd - 1), t(jd + 1:SIZE(t))]; CALL MOVE_ALLOC(FROM = tt, TO = t) !--- Remove the virtual tracer named "defName"
	479	END SUBROUTINE addDefault
	480	!==============================================================================================================================
[4046]	481
[5117]	482	!==============================================================================================================================
	483	SUBROUTINE subDefault(t, defName, lSubLocal)
	484	!------------------------------------------------------------------------------------------------------------------------------
	485	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	486	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
	487	!------------------------------------------------------------------------------------------------------------------------------
	488	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	489	CHARACTER(LEN = *), INTENT(IN) :: defName
	490	LOGICAL, INTENT(IN) :: lSubLocal
	491	INTEGER :: i0, it, ik
	492	TYPE(keys_type), POINTER :: k0, ky
	493	TYPE(trac_type), ALLOCATABLE :: tt(:)
	494	i0 = strIdx(t(:)%name, defName)
	495	IF(i0 == 0) RETURN
	496	k0 => t(i0)%keys
	497	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
[4046]	498	ky => t(it)%keys
	499
	500	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
[5117]	501	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.);
	502	END DO
[4046]	503
	504	IF(.NOT.lSubLocal) CYCLE
	505	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
[5117]	506	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.);
	507	END DO
	508	END DO
	509	tt = [t(1:i0 - 1), t(i0 + 1:SIZE(t))]; CALL MOVE_ALLOC(FROM = tt, TO = t) !--- Remove the virtual tracer named "defName"
[4046]	510
[5117]	511	END SUBROUTINE subDefault
	512	!==============================================================================================================================
[4046]	513
	514
[5117]	515	!==============================================================================================================================
	516	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
	517	!------------------------------------------------------------------------------------------------------------------------------
	518	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
	519	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
	520	! * Default values are provided for these keys because they are necessary.
	521	!------------------------------------------------------------------------------------------------------------------------------
	522	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	523	CHARACTER(LEN = *), INTENT(IN) :: sname !--- Current section name
	524	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname !--- Tracers description file name
	525	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	526	CHARACTER(LEN = maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
	527	CHARACTER(LEN = maxlen) :: msg1, modname
	528	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
	529	LOGICAL :: ll
	530	modname = 'expandSection'
	531	lerr = .FALSE.
	532	nt = SIZE(tr)
	533	lerr = getKey('name', tname, tr(:)%keys); IF(lerr) RETURN
	534	lerr = getKey('parent', parent, tr(:)%keys, def = tran0); IF(lerr) RETURN
	535	lerr = getKey('type', dType, tr(:)%keys, def = 'tracer'); IF(lerr) RETURN
	536	nq = 0
	537	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	538	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
	539	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	540	!--- Extract useful keys: parent name, type, component name
	541	tr(it)%component = sname
	542	CALL addKey('component', sname, tr(it)%keys)
[4046]	543
[5117]	544	!--- Determine the number of tracers and parents ; coherence checking
	545	ll = strCount(tname(it), ',', ntr)
	546	ll = strCount(parent(it), ',', npr)
[4046]	547
[5117]	548	!--- Tagging tracers only can have multiple parents
	549	lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
	550	IF(lerr) THEN
	551	msg1 = 'Check section "' // TRIM(sname) // '"'
	552	IF(PRESENT(fname)) msg1 = TRIM(msg1) // ' in file "' // TRIM(fname) // '"'
	553	CALL msg(TRIM(msg1) // ': "' // TRIM(tname(it)) // '" has several parents but is not a tag', modname); RETURN
	554	END IF
	555	nq = nq + ntr * npr
	556	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	557	END DO
	558	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4046]	559
[5117]	560	ALLOCATE(ttr(nq))
	561	iq = 1
	562	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	563	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
	564	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	565	ll = strParse(tname(it), ',', ta, ntr) !--- Number of tracers
	566	ll = strParse(parent(it), ',', pa, npr) !--- Number of parents
	567	DO ipr = 1, npr !--- Loop on parents list elts
	568	DO itr = 1, ntr !--- Loop on tracers list elts
	569	ttr(iq)%keys%name = TRIM(ta(itr))
	570	ttr(iq)%keys%key = tr(it)%keys%key
	571	ttr(iq)%keys%val = tr(it)%keys%val
	572	ttr(iq)%name = TRIM(ta(itr))
	573	ttr(iq)%parent = TRIM(pa(ipr))
	574	ttr(iq)%type = dType(it)
	575	ttr(iq)%component = sname
	576	CALL addKey('name', ta(itr), ttr(iq)%keys)
	577	CALL addKey('parent', pa(ipr), ttr(iq)%keys)
	578	CALL addKey('type', dType(it), ttr(iq)%keys)
	579	CALL addKey('component', sname, ttr(iq)%keys)
	580	iq = iq + 1
	581	END DO
[4046]	582	END DO
[5117]	583	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4046]	584	END DO
[5117]	585	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	586	DEALLOCATE(ta, pa)
	587	CALL MOVE_ALLOC(FROM = ttr, TO = tr)
[4046]	588
[5117]	589	END FUNCTION expandSection
	590	!==============================================================================================================================
[4046]	591
[4328]	592
[5117]	593	!==============================================================================================================================
	594	LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
	595	!------------------------------------------------------------------------------------------------------------------------------
	596	! Purpose: Determine, for each tracer of "tr(:)":
	597	! * iGeneration: the generation number
	598	! * gen0Name: the generation 0 ancestor name
	599	! Check also for orphan tracers (tracers without parent).
	600	!------------------------------------------------------------------------------------------------------------------------------
	601	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	602	INTEGER :: iq, jq, ig
	603	CHARACTER(LEN = maxlen), ALLOCATABLE :: parent(:), tname(:)
	604	!------------------------------------------------------------------------------------------------------------------------------
	605	CHARACTER(LEN = maxlen) :: modname
	606	modname = 'setGeneration'
	607	lerr = getKey('name', tname, ky = tr(:)%keys); IF(lerr) RETURN
	608	lerr = getKey('parent', parent, ky = tr(:)%keys); IF(lerr) RETURN
	609	DO iq = 1, SIZE(tr)
	610	jq = iq; ig = 0
	611	DO WHILE(parent(jq) /= tran0)
	612	jq = strIdx(tname(:), parent(jq))
	613	lerr = jq == 0
	614	IF(fmsg('Orphan tracer "' // TRIM(tname(iq)) // '"', modname, lerr)) RETURN
	615	ig = ig + 1
	616	END DO
	617	tr(iq)%gen0Name = tname(jq)
	618	tr(iq)%iGeneration = ig
	619	CALL addKey('iGeneration', ig, tr(iq)%keys)
	620	CALL addKey('gen0Name', tname(jq), tr(iq)%keys)
[4328]	621	END DO
[5117]	622	END FUNCTION setGeneration
	623	!==============================================================================================================================
[4046]	624
[4328]	625
[5117]	626	!==============================================================================================================================
	627	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
	628	!------------------------------------------------------------------------------------------------------------------------------
	629	! Purpose:
	630	! * check for orphan tracers (without parent)
	631	! * check wether the phases are known or not (elements of "known_phases")
	632	!------------------------------------------------------------------------------------------------------------------------------
	633	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
	634	CHARACTER(LEN = *), INTENT(IN) :: sname !--- Section name
	635	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname !--- File name
	636	CHARACTER(LEN = 1) :: p
	637	CHARACTER(LEN = maxlen) :: mesg
	638	CHARACTER(LEN = maxlen) :: bp(SIZE(tr, DIM = 1)), pha !--- Bad phases list, phases of current tracer
	639	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:)
	640	INTEGER, ALLOCATABLE :: iGen(:)
	641	INTEGER :: ip, np, iq, nq
	642	!------------------------------------------------------------------------------------------------------------------------------
	643	CHARACTER(LEN = maxlen) :: modname
	644	modname = 'checkTracers'
	645	nq = SIZE(tr, DIM = 1) !--- Number of tracers lines
	646	mesg = 'Check section "' // TRIM(sname) // '"'
	647	IF(PRESENT(fname)) mesg = TRIM(mesg) // ' in file "' // TRIM(fname) // '"'
	648	lerr = getKey('iGeneration', iGen, tr(:)%keys); IF(lerr) RETURN
	649	lerr = getKey('name', tname, tr(:)%keys); IF(lerr) RETURN
[4046]	650
[5117]	651	!=== CHECK FOR ORPHAN TRACERS
	652	lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
[4046]	653
[5117]	654	!=== CHECK PHASES
	655	DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE !--- Generation O only is checked
	656	IF(getKey(['phases', 'phase '], pha, iq, tr(:)%keys, lDisp = .FALSE.)) pha = 'g' !--- Phase
	657	np = LEN_TRIM(pha); bp(iq) = ' '
	658	DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq)) // p;
	659	END DO
	660	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq)) // ': ' // TRIM(bp(iq))
	661	END DO
	662	lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
	663	END FUNCTION checkTracers
	664	!==============================================================================================================================
[4046]	665
[4328]	666
[5117]	667	!==============================================================================================================================
	668	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
	669	!------------------------------------------------------------------------------------------------------------------------------
	670	! Purpose: Make sure that tracers are not repeated.
	671	!------------------------------------------------------------------------------------------------------------------------------
	672	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
	673	CHARACTER(LEN = *), INTENT(IN) :: sname !--- Section name
	674	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname !--- File name
	675	!------------------------------------------------------------------------------------------------------------------------------
	676	INTEGER :: ip, np, iq, nq, k
	677	LOGICAL, ALLOCATABLE :: ll(:)
	678	CHARACTER(LEN = maxlen) :: mesg, phase, tdup(SIZE(tr, DIM = 1))
	679	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), dType(:)
	680	INTEGER, ALLOCATABLE :: iGen(:)
	681	CHARACTER(LEN = 1) :: p
	682	!------------------------------------------------------------------------------------------------------------------------------
	683	CHARACTER(LEN = maxlen) :: modname
	684	modname = 'checkUnique'
	685	mesg = 'Check section "' // TRIM(sname) // '"'
	686	IF(PRESENT(fname)) mesg = TRIM(mesg) // ' in file "' // TRIM(fname) // '"'
	687	nq = SIZE(tr, DIM = 1); lerr = .FALSE. !--- Number of lines ; error flag
	688	tdup(:) = ''
	689	lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN
	690	lerr = getKey('type', dType, tr%keys); IF(lerr) RETURN
	691	lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN
	692	DO iq = 1, nq
	693	IF(dType(iq) == 'tag') CYCLE !--- Tags can be repeated
	694	ll = tname==TRIM(tname(iq)) !--- Mask for current tracer name
	695	IF(COUNT(ll) == 1) CYCLE !--- Tracer is not repeated
	696	IF(iGen(iq) > 0) THEN
	697	tdup(iq) = tname(iq) !--- gen>0: MUST be unique
	698	ELSE
	699	DO ip = 1, nphases; p = known_phases(ip:ip) !--- Loop on known phases
[5001]	700	np = 0
	701	DO k = 1, nq
	702	IF(.NOT.ll(k)) CYCLE !--- Skip tracers different from current one
[5117]	703	IF(getKey(['phases', 'phase '], phase, k, tr%keys, lDisp = .FALSE.)) phase = 'g'!--- Get current phases
[5001]	704	IF(INDEX(phase, p) /= 0) np = np + 1 !--- One more appearance of current tracer with phase "p"
	705	END DO
	706	IF(np <= 1) CYCLE !--- Regular case: no or a single appearance
[5117]	707	tdup(iq) = TRIM(tdup(iq)) // TRIM(phases_names(ip)) !--- Repeated phase
	708	IF(ANY(tdup(1:iq - 1) == tdup(iq))) tdup(iq) = '' !--- Avoid repeating same messages
	709	END DO
	710	END IF
	711	IF(tdup(iq) /= '') tdup(iq) = TRIM(tname(iq)) // ' in ' // TRIM(tdup(iq)) // ' phase(s)'
	712	END DO
	713	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
	714	END FUNCTION checkUnique
	715	!==============================================================================================================================
[4046]	716
[4328]	717
[5117]	718	!==============================================================================================================================
	719	LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
	720	!------------------------------------------------------------------------------------------------------------------------------
	721	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
	722	!------------------------------------------------------------------------------------------------------------------------------
	723	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	724	!------------------------------------------------------------------------------------------------------------------------------
	725	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	726	INTEGER, ALLOCATABLE :: i0(:), iGen(:)
	727	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
	728	CHARACTER(LEN = maxlen) :: nam, gen0Nm, pha, parent
	729	CHARACTER(LEN = 1) :: p
	730	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
	731	LOGICAL :: lTag, lExt
	732	!------------------------------------------------------------------------------------------------------------------------------
	733	CHARACTER(LEN = maxlen) :: modname
	734	modname = 'expandPhases'
	735	nq = SIZE(tr, DIM = 1)
	736	nt = 0
	737	lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN !--- Names of the tracers
	738	lerr = getKey('gen0Name', gen0N, tr%keys); IF(lerr) RETURN !--- Names of the tracers of first generation
	739	lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN !--- Generation number
	740	lerr = getKey('phases', phase, tr%keys); IF(lerr) RETURN !--- Phases names
	741	lerr = getKey('parent', parents, tr%keys); IF(lerr) RETURN !--- Parents names
	742	lerr = getKey('type', dType, tr%keys); IF(lerr) RETURN !--- Tracers types ('tracer' or 'tag')
	743	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
	744	IF(iGen(iq) /= 0) CYCLE !--- Only deal with generation 0 tracers
	745	nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0) !--- Number of children of tr(iq)
	746	np = LEN_TRIM(phase(iq)) !--- Number of phases of tr(iq)
	747	nt = nt + (1 + nc) * np !--- Number of tracers after expansion
	748	END DO
	749	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
	750	it = 1 !--- Current "ttr(:)" index
	751	DO iq = 1, nq !--- Loop on "tr(:)" indexes
	752	lTag = dType(iq)=='tag' !--- Current tracer is a tag
	753	i0 = strFind(tname, TRIM(gen0N(iq)), n) !--- Indexes of first generation ancestor copies
	754	np = SUM([(LEN_TRIM(phase(i0(i))), i = 1, n)], 1) !--- Number of phases for current tracer tr(iq)
	755	lExt = np > 1 !--- Phase suffix only required if phases number is > 1
	756	IF(lTag) lExt = lExt .AND. iGen(iq) > 0 !--- No phase suffix for generation 0 tags
	757	DO i = 1, n !=== LOOP ON GENERATION 0 ANCESTORS
	758	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
	759	IF(iGen(iq) == 0) jq = iq !--- Generation 0: count the current tracer phases only
	760	pha = phase(jq) !--- Phases list for tr(jq)
	761	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
	762	p = pha(ip:ip)
	763	nam = tname(iq) !--- Tracer name (regular case)
	764	IF(lTag) nam = TRIM(parents(iq)) !--- Parent name (tagging case)
	765	IF(lExt) nam = addPhase(nam, p) !--- Phase extension needed
	766	IF(lTag) nam = TRIM(nam) // '_' // TRIM(tname(iq)) !--- <parent>_<name> for tags
	767	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
	768	ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix
	769	ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor
	770	ttr(it)%phase = p !--- Single phase entry
	771	CALL addKey('name', nam, ttr(it)%keys)
	772	CALL addKey('phase', p, ttr(it)%keys)
	773	IF(lExt) THEN
	774	parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
	775	gen0Nm = gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
	776	ttr(it)%parent = parent
	777	ttr(it)%gen0Name = gen0Nm
	778	CALL addKey('parent', parent, ttr(it)%keys)
	779	CALL addKey('gen0Name', gen0Nm, ttr(it)%keys)
	780	END IF
	781	it = it + 1
	782	END DO
	783	IF(iGen(iq) == 0) EXIT !--- Break phase loop for gen 0
[4046]	784	END DO
	785	END DO
[5117]	786	CALL MOVE_ALLOC(FROM = ttr, TO = tr)
	787	CALL delKey(['phases'], tr) !--- Remove few keys entries
[4046]	788
[5117]	789	END FUNCTION expandPhases
	790	!==============================================================================================================================
[4046]	791
[4328]	792
[5117]	793	!==============================================================================================================================
	794	SUBROUTINE sortTracers(tr)
	795	!------------------------------------------------------------------------------------------------------------------------------
	796	! Purpose: Sort tracers:
	797	! * Put water at the beginning of the vector, in the "known_phases" order.
	798	! * lGrowGen == T: in ascending generations numbers.
	799	! * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
	800	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
	801	!------------------------------------------------------------------------------------------------------------------------------
	802	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	803	!------------------------------------------------------------------------------------------------------------------------------
	804	TYPE(trac_type), ALLOCATABLE :: tr2(:)
	805	INTEGER, ALLOCATABLE :: iy(:), iz(:)
	806	INTEGER, ALLOCATABLE :: iGen(:)
	807	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), gen0N(:)
	808	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
	809	LOGICAL :: lerr
	810	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
	811	!------------------------------------------------------------------------------------------------------------------------------
	812	lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN !--- Generation number
	813	nq = SIZE(tr)
	814	DO ip = nphases, 1, -1
	815	lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN !--- Names of the tracers of first generation
	816	iq = strIdx(tname, addPhase('H2O', ip))
	817	IF(iq == 0) CYCLE
	818	tr2 = tr(:)
	819	tr = [tr2(iq), tr2(1:iq - 1), tr2(iq + 1:nq)]
[4046]	820	END DO
[5117]	821	IF(lSortByGen) THEN
	822	iq = 1
	823	ng = MAXVAL(iGen, MASK = .TRUE., DIM = 1) !--- Number of generations
	824	DO ig = 0, ng !--- Loop on generations
	825	iy = PACK([(k, k = 1, nq)], MASK = iGen(:) == ig) !--- Generation ig tracers indexes
	826	n = SIZE(iy)
	827	ix(iq:iq + n - 1) = iy !--- Stack growing generations idxs
[4046]	828	iq = iq + n
	829	END DO
[5117]	830	ELSE
	831	lerr = getKey('gen0Name', gen0N, tr%keys); IF(lerr) RETURN !--- Names of the tracers iq = 1
	832	DO jq = 1, nq !--- Loop on generation 0 tracers
	833	IF(iGen(jq) /= 0) CYCLE !--- Skip generations /= 0
	834	ix(iq) = jq !--- Generation 0 ancestor index first
	835	iq = iq + 1 !--- Next "iq" for next generations tracers
	836	iy = strFind(gen0N(:), TRIM(tname(jq))) !--- Indices of "tr(jq)" children in "tr(:)"
	837	ng = MAXVAL(iGen(iy), MASK = .TRUE., DIM = 1) !--- Number of generations of the "tr(jq)" family
	838	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
	839	iz = find(iGen(iy), ig, n) !--- Indices of the tracers "tr(iy(:))" of generation "ig"
	840	ix(iq:iq + n - 1) = iy(iz) !--- Same indexes in "tr(:)"
	841	iq = iq + n
	842	END DO
	843	END DO
	844	END IF
	845	tr = tr(ix) !--- Reorder the tracers
	846	END SUBROUTINE sortTracers
	847	!==============================================================================================================================
[4046]	848
[4325]	849
[5117]	850	!==============================================================================================================================
	851	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
	852	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	853	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	854	TYPE(trac_type), POINTER :: t1(:), t2(:)
	855	TYPE(keys_type), POINTER :: k1(:), k2(:)
	856	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
	857	INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
	858	CHARACTER(LEN = maxlen) :: s1, v1, v2, tnam, knam, modname
	859	CHARACTER(LEN = maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
	860	modname = 'mergeTracers'
	861	lerr = .FALSE.
	862	keys = ['parent ', 'type ', 'iGeneration'] !--- Mandatory keys
	863	t1 => sections(1)%trac(:); k1 => t1(:)%keys !--- Alias: first tracers section, corresponding keys
	864	lerr = getKey('name', n1, k1); IF(lerr) RETURN !--- Names of the tracers
	865	tr = t1
	866	!----------------------------------------------------------------------------------------------------------------------------
	867	DO is = 2, SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
	868	!----------------------------------------------------------------------------------------------------------------------------
	869	t2 => sections(is)%trac(:) !--- Alias: current tracers section
	870	k2 => t2(:)%keys
	871	lerr = getKey('name', n2, k2); IF(lerr) RETURN !--- Names of the tracers
	872	nt2 = SIZE(t2(:), DIM = 1) !--- Number of tracers in section
	873	ixct = strIdx(n1(:), n2(:)) !--- Indexes of common tracers
	874	tr = [tr, PACK(t2, MASK = ixct==0)] !--- Append with new tracers
	875	IF(ALL(ixct == 0)) CYCLE !--- No common tracers => done
	876	CALL msg('Tracers defined in previous sections and duplicated in "' // TRIM(sections(is)%name) // '":', modname)
	877	CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax = 128) !--- Display duplicates (the 128 first at most)
	878	!--------------------------------------------------------------------------------------------------------------------------
	879	DO i2 = 1, nt2; tnam = TRIM(t2(i2)%name) !=== LOOP ON COMMON TRACERS
	880	!--------------------------------------------------------------------------------------------------------------------------
[4046]	881	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
	882
	883	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
[5117]	884	s1 = ' of "' // TRIM(tnam) // '" in "' // TRIM(sections(is)%name) // '" not matching previous value'
[5001]	885	DO ik = 1, SIZE(keys)
	886	lerr = getKey(keys(ik), v1, i1, k1)
	887	lerr = getKey(keys(ik), v2, i2, k2)
[5117]	888	lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik)) // TRIM(s1), modname, lerr)) RETURN
[5001]	889	END DO
[4046]	890
[5001]	891	!=== GET THE INDICES IN tr(i2)%keys%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%keys%key(:)
[5117]	892	nk2 = SIZE(k2(i2)%key(:)) !--- Keys number in current section
[5001]	893	ixck = strIdx(k1(i1)%key(:), k2(i2)%key(:)) !--- Common keys indexes
	894	!--- APPEND THE NEW KEYS PAIRS IN tr(i1)%keys%key(:)
[4046]	895	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
	896	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
	897
[5001]	898	!=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
	899	lerr = getKey('component', v1, i1, k1)
	900	lerr = getKey('component', v2, i2, k2)
[5117]	901	tr(i1)%component = TRIM(v1) // ',' // TRIM(v2)
	902	CALL addKey('component', TRIM(v1) // ',' // TRIM(v2), tr(i1)%keys)
[4046]	903
[5001]	904	!=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
	905	DO ik2 = 1, nk2 !--- Collect the corresponding indices
	906	ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
[5117]	907	IF(k1(i1)%val(ik1) == k2(i2)%val(ik2)) ixck(ik2) = 0
[4046]	908	END DO
[5001]	909	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values => nothing to display
[5117]	910	CALL msg('Key(s)' // TRIM(s1), modname) !--- Display the keys with /=values (names list)
[5001]	911	DO ik2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
	912	knam = k2(i2)%key(ik2) !--- Name of the current key
	913	ik1 = ixck(ik2) !--- Corresponding index in t1(:)
	914	IF(ik1 == 0) CYCLE !--- New keys are skipped
	915	v1 = k1(i1)%val(ik1); v2 = k2(i2)%val(ik2) !--- Key values in t1(:) and t2(:)
[5117]	916	CALL msg(' * ' // TRIM(knam) // '=' // TRIM(v2) // ' ; previous value kept:' // TRIM(v1), modname)
[4046]	917	END DO
	918	!------------------------------------------------------------------------------------------------------------------------
[5117]	919	END DO
	920	!--------------------------------------------------------------------------------------------------------------------------
[4046]	921	END DO
[5117]	922	CALL sortTracers(tr)
[4046]	923
[5117]	924	END FUNCTION mergeTracers
	925	!==============================================================================================================================
[4046]	926
[5117]	927	!==============================================================================================================================
	928	LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
	929	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	930	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	931	LOGICAL, OPTIONAL, INTENT(IN) :: lRename !--- .TRUE.: add a section suffix to identical names
	932	CHARACTER(LEN = maxlen) :: tnam_new, modname
	933	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
	934	INTEGER :: iq, jq, is
	935	modname = 'cumulTracers'
	936	lerr = .FALSE.
	937	tr = [(sections(is)%trac(:), is = 1, SIZE(sections))] !--- Concatenated tracers vector
	938	IF(PRESENT(lRename)) THEN; IF(lRename) RETURN;
	939	END IF !--- No renaming: finished
	940	lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN !--- Names
	941	lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN !--- Parents
	942	lerr = getKey('component', comp, tr%keys); IF(lerr) RETURN !--- Component name
	943	!----------------------------------------------------------------------------------------------------------------------------
	944	DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE !=== LOOP ON TRACERS
	945	!----------------------------------------------------------------------------------------------------------------------------
	946	tnam_new = TRIM(tname(iq)) // '_' // TRIM(comp(iq)) !--- Same with section extension
[5001]	947	CALL addKey('name', tnam_new, tr(iq)%keys) !--- Modify tracer name
	948	tr(iq)%name = TRIM(tnam_new) !--- Modify tracer name
[4046]	949	!--------------------------------------------------------------------------------------------------------------------------
[5001]	950	DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE !=== LOOP ON TRACERS PARENTS
[4046]	951	!--------------------------------------------------------------------------------------------------------------------------
[5117]	952	CALL addKey('parent', tnam_new, tr(jq)%keys) !--- Modify tracer name
	953	tr(jq)%parent = TRIM(tnam_new) !--- Modify tracer name
[4046]	954	!--------------------------------------------------------------------------------------------------------------------------
	955	END DO
[5117]	956	!----------------------------------------------------------------------------------------------------------------------------
	957	END DO
	958	!----------------------------------------------------------------------------------------------------------------------------
	959	CALL sortTracers(tr)
	960	END FUNCTION cumulTracers
	961	!==============================================================================================================================
[4046]	962
[4063]	963
[5117]	964	!==============================================================================================================================
	965	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
	966	CHARACTER(LEN = *), INTENT(IN) :: message, sname, modname
	967	CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:, :), n(:), tmp(:)
	968	CHARACTER(LEN = maxlen) :: p
	969	INTEGER :: idb, iq, nq
	970	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
	971	nq = SIZE(dBase(idb)%trac)
	972	p = ''
	973	CALL append(['iq'], .TRUE.); IF(lerr) RETURN
	974	CALL append(['name'], .TRUE.); IF(lerr) RETURN
	975	CALL append(['phases', 'phase '], .FALSE., 'pha'); IF(lerr) RETURN
	976	CALL append(['hadv'], .TRUE.); IF(lerr) RETURN
	977	CALL append(['vadv'], .TRUE.); IF(lerr) RETURN
	978	CALL append(['parent'], .FALSE.); IF(lerr) RETURN
	979	CALL append(['iGen'], .FALSE.); IF(lerr) RETURN
	980	CALL msg(TRIM(message) // ':', modname)
	981	lerr = dispTable(p, n, s, nColMax = maxTableWidth, nHead = 2, sub = modname); IF(lerr) RETURN
[5001]	982
[5117]	983	CONTAINS
[5001]	984
[5117]	985	SUBROUTINE append(nam, lMandatory, snam)
	986	! Test whether key named "nam(:)" is available.
	987	! * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
	988	! - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
	989	! * no: return to calling routine with an error flag if the required key is mandatory
	990	CHARACTER(LEN = *), INTENT(IN) :: nam(:)
	991	LOGICAL, INTENT(IN) :: lMandatory
	992	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: snam
	993	INTEGER :: m
	994	CHARACTER(LEN = maxlen), ALLOCATABLE :: n0(:)
	995	CHARACTER(LEN = maxlen) :: nm
	996	lerr = .FALSE.
	997	IF(nam(1) == 'iq') THEN
	998	tmp = int2str([(iq, iq = 1, nq)])
	999	ELSE
	1000	lerr = getKey(nam, tmp, dBase(idb)%trac(:)%keys, lDisp = lMandatory)
	1001	END IF
	1002	IF(lerr) THEN; lerr = lMandatory; RETURN;
	1003	END IF
	1004	nm = nam(1); IF(PRESENT(snam)) nm = snam
	1005	p = TRIM(p) // 's'
	1006	IF(ALLOCATED(s)) THEN; s = cat(s, tmp);
	1007	ELSE; ALLOCATE(s(nq, 1)); s(:, 1) = tmp;
	1008	END IF
	1009	IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m + 1)); n0(1:m) = n; n0(m + 1) = nm; CALL MOVE_ALLOC(FROM = n0, TO = n)
	1010	ELSE; n = nam(1:1);
	1011	END IF
	1012	END SUBROUTINE append
[5001]	1013
[5117]	1014	END FUNCTION dispTraSection
	1015	!==============================================================================================================================
[4046]	1016
	1017
[5117]	1018	!==============================================================================================================================
	1019	!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
	1020	!==============================================================================================================================
	1021	LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr) !=== TRACER NAMED "tname" - SCALAR
	1022	CHARACTER(LEN = *), INTENT(IN) :: tname
	1023	TYPE(trac_type), TARGET, INTENT(IN) :: trac(:)
	1024	TYPE(trac_type), POINTER, INTENT(OUT) :: alias
	1025	INTEGER :: it
	1026	CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
	1027	alias => NULL()
	1028	lerr = getKey('name', tnames, trac(:)%keys)
	1029	it = strIdx(tnames, tname)
	1030	lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
	1031	END FUNCTION aliasTracer
	1032	!==============================================================================================================================
	1033	LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr) !=== TRACERS WITH INDICES "idx(:)" - VECTOR
	1034	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	1035	INTEGER, INTENT(IN) :: idx(:)
	1036	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
	1037	alias = trac(idx)
	1038	lerr = indexUpdate(alias)
	1039	END FUNCTION trSubset_Indx
	1040	!------------------------------------------------------------------------------------------------------------------------------
	1041	LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr) !=== TRACERS NAMED "tname(:)" - VECTOR
	1042	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	1043	CHARACTER(LEN = *), INTENT(IN) :: tname(:)
	1044	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
	1045	CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
	1046	lerr = getKey('name', tnames, trac(:)%keys)
	1047	alias = trac(strIdx(tnames, tname))
	1048	lerr = indexUpdate(alias)
	1049	END FUNCTION trSubset_Name
	1050	!==============================================================================================================================
	1051	LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr) !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
	1052	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	1053	CHARACTER(LEN = *), INTENT(IN) :: gen0Nm
	1054	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
	1055	CHARACTER(LEN = maxlen), ALLOCATABLE :: gen0N(:)
	1056	lerr = getKey('gen0Name', gen0N, trac(:)%keys)
	1057	alias = trac(strFind(delPhase(gen0N), gen0Nm))
	1058	lerr = indexUpdate(alias)
	1059	END FUNCTION trSubset_gen0Name
	1060	!==============================================================================================================================
[4046]	1061
	1062
[5117]	1063	!==============================================================================================================================
	1064	!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
	1065	!==============================================================================================================================
	1066	LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
	1067	TYPE(trac_type), INTENT(INOUT) :: tr(:)
	1068	INTEGER :: iq, jq, nq, ig, nGen
	1069	INTEGER, ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
	1070	CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:), parent(:)
	1071	INTEGER, DIMENSION(SIZE(tr)) :: iqParent, iGen
	1072	lerr = getKey('name', tnames, tr%keys); IF(lerr) RETURN !--- Names
	1073	lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN !--- Parents
	1074	nq = SIZE(tr)
[5001]	1075
[5117]	1076	!=== iqParent, iGeneration
	1077	DO iq = 1, nq; iGen(iq) = 0; jq = iq
[5004]	1078	iqParent(iq) = strIdx(tnames, parent(iq))
[5117]	1079	DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1;
	1080	END DO
	1081	CALL addKey('iqParent', parent(iq), tr(iq)%keys)
[5004]	1082	CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
[5117]	1083	END DO
[5001]	1084
[5117]	1085	!=== nqChildren, iqDescen, nqDescen
	1086	nGen = MAXVAL(iGen, MASK = .TRUE.)
	1087	DO iq = 1, nq
	1088	ix = [iq]; ALLOCATE(iqDescen(0))
	1089	DO ig = iGen(iq) + 1, nGen
	1090	iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
	1091	IF(ig /= iGen(iq) + 1) CYCLE
	1092	CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
	1093	tr(iq)%nqChildren = SIZE(iqDescen)
	1094	END DO
	1095	CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq)%keys)
	1096	CALL addKey('nqDescen', SIZE(iqDescen), tr(iq)%keys)
	1097	tr(iq)%iqDescen = iqDescen
	1098	tr(iq)%nqDescen = SIZE(iqDescen)
	1099	DEALLOCATE(iqDescen)
[4120]	1100	END DO
[5117]	1101	END FUNCTION indexUpdate
	1102	!==============================================================================================================================
[4046]	1103
	1104
[5117]	1105	!==============================================================================================================================
	1106	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
	1107	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
	1108	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
	1109	!=== NOTES: ====
	1110	!=== * Most of the "isot" components have been defined in the calling routine (processIsotopes): ====
	1111	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
	1112	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
	1113	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
	1114	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
	1115	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
	1116	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
	1117	!==============================================================================================================================
	1118	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
	1119	CHARACTER(LEN = *), INTENT(IN) :: fnam !--- Input file name
	1120	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!)
	1121	LOGICAL :: lFound
	1122	INTEGER :: is, iis, it, idb, ndb, nb0
	1123	CHARACTER(LEN = maxlen), ALLOCATABLE :: vals(:)
	1124	CHARACTER(LEN = maxlen) :: modname
	1125	TYPE(trac_type), POINTER :: tt(:), t
	1126	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	1127	modname = 'readIsotopesFile'
[4046]	1128
[5117]	1129	!--- THE INPUT FILE MUST BE PRESENT
	1130	INQUIRE(FILE = TRIM(fnam), EXIST = lFound); lerr = .NOT.lFound
	1131	IF(fmsg('Missing isotopes parameters file "' // TRIM(fnam) // '"', modname, lerr)) RETURN
[4046]	1132
[5117]	1133	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
	1134	nb0 = SIZE(dBase, DIM = 1) + 1 !--- Next database element index
	1135	lerr = readSections(fnam, strStack(isot(:)%parent, '\|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
	1136	ndb = SIZE(dBase, DIM = 1) !--- Current database size
	1137	DO idb = nb0, ndb
	1138	iis = idb - nb0 + 1
[4046]	1139
[5117]	1140	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
	1141	CALL addKeysFromDef(dBase(idb)%trac, 'params')
[4046]	1142
[5117]	1143	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
	1144	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
	1145
	1146	tt => dBase(idb)%trac
	1147
	1148	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
	1149	DO it = 1, SIZE(dBase(idb)%trac)
	1150	t => dBase(idb)%trac(it)
	1151	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
	1152	IF(is == 0) CYCLE
	1153	lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN !--- Reduce expressions ; detect non-numerical elements
	1154	isot(iis)%keys(is)%key = t%keys%key
	1155	isot(iis)%keys(is)%val = vals
	1156	END DO
	1157
	1158	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
	1159	lerr = checkList(isot(iis)%keys(:)%name, .NOT.[(ALLOCATED(isot(iis)%keys(is)%key), is = 1, SIZE(isot(iis)%keys))], &
	1160	'Check file "' // TRIM(fnam) // '" in section "' // TRIM(dBase(idb)%name) // '"', 'isotopes', 'missing')
	1161	IF(lerr) RETURN
[4046]	1162	END DO
	1163
[5117]	1164	!--- CLEAN THE DATABASE ENTRIES
	1165	IF(nb0 == 1) THEN
	1166	DEALLOCATE(dBase); ALLOCATE(dBase(0))
	1167	ELSE
	1168	ALLOCATE(tdb(nb0 - 1)); tdb(1:nb0 - 1) = dBase(1:nb0 - 1); CALL MOVE_ALLOC(FROM = tdb, TO = dBase)
	1169	END IF
[4046]	1170
[5117]	1171	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
	1172	CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
[4120]	1173
[5117]	1174	lerr = dispIsotopes()
[4120]	1175
[5117]	1176	CONTAINS
[4046]	1177
[5117]	1178	!------------------------------------------------------------------------------------------------------------------------------
	1179	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
	1180	INTEGER :: ik, nk, ip, it, nt
	1181	CHARACTER(LEN = maxlen) :: prf
	1182	CHARACTER(LEN = maxlen), ALLOCATABLE :: ttl(:), val(:, :)
	1183	CALL msg('Isotopes parameters read from file "' // TRIM(fnam) // '":', modname)
	1184	DO ip = 1, SIZE(isot) !--- Loop on parents tracers
	1185	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
	1186	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
	1187	prf = 'i' // REPEAT('s', nk + 1) !--- Profile for table printing
	1188	ALLOCATE(ttl(nk + 2), val(nt, nk + 1))
	1189	ttl(1:2) = ['it ', 'name']; ttl(3:nk + 2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
	1190	val(:, 1) = isot(ip)%keys(:)%name !--- Values table 1st column: isotopes names
	1191	DO ik = 1, nk
	1192	DO it = 1, nt
	1193	val(it, ik + 1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
	1194	END DO
	1195	END DO
	1196	lerr = dispTable(prf, ttl, val, cat([(it, it = 1, nt)]), rFmt = '(EN8.4)', nColMax = maxTableWidth, nHead = 2, sub = modname)
	1197	IF(fmsg('Problem with the table content', modname, lerr)) RETURN
	1198	DEALLOCATE(ttl, val)
[4325]	1199	END DO
[5117]	1200	END FUNCTION dispIsotopes
	1201	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1202
[5117]	1203	END FUNCTION readIsotopesFile
	1204	!==============================================================================================================================
[4046]	1205
[4301]	1206
[5117]	1207	!==============================================================================================================================
	1208	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
	1209	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
	1210	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
	1211	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
	1212	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
	1213	!==============================================================================================================================
	1214	LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
	1215	CHARACTER(LEN = maxlen), TARGET, OPTIONAL, INTENT(IN) :: iNames(:)
	1216	CHARACTER(LEN = maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
	1217	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
	1218	CHARACTER(LEN = maxlen) :: iName, modname
	1219	CHARACTER(LEN = 1) :: ph !--- Phase
	1220	INTEGER, ALLOCATABLE :: iGen(:)
	1221	INTEGER :: ic, ip, iq, it, iz
	1222	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
	1223	TYPE(trac_type), POINTER :: t(:), t1
	1224	TYPE(isot_type), POINTER :: i
[5001]	1225
[5117]	1226	lerr = .FALSE.
	1227	modname = 'readIsotopesFile'
[4046]	1228
[5117]	1229	t => tracers
[4046]	1230
[5117]	1231	lerr = getKey('name', tname, t%keys); IF(lerr) RETURN !--- Names
	1232	lerr = getKey('parent', parent, t%keys); IF(lerr) RETURN !--- Parents
	1233	lerr = getKey('type', dType, t%keys); IF(lerr) RETURN !--- Tracer type
	1234	lerr = getKey('phase', phase, t%keys); IF(lerr) RETURN !--- Phase
	1235	lerr = getKey('gen0Name', gen0N, t%keys); IF(lerr) RETURN !--- 1st generation ancestor name
	1236	lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN !--- Generation number
[5001]	1237
[5117]	1238	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
	1239	p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
	1240	CALL strReduce(p, nbIso)
[4046]	1241
[5117]	1242	!--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
	1243	IF(PRESENT(iNames)) THEN
	1244	DO it = 1, SIZE(iNames)
	1245	lerr = ALL(p /= iNames(it))
	1246	IF(fmsg('No isotopes class "' // TRIM(iNames(it)) // '" found among tracers', modname, lerr)) RETURN
	1247	END DO
	1248	p = iNames; nbIso = SIZE(p)
	1249	END IF
	1250	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
	1251	ALLOCATE(isotopes(nbIso))
[4325]	1252
[5117]	1253	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
[4046]	1254
[5117]	1255	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
	1256	isotopes(:)%parent = p
	1257	DO ic = 1, SIZE(p) !--- Loop on isotopes classes
	1258	i => isotopes(ic)
	1259	iname = i%parent !--- Current isotopes class name (parent tracer name)
[4046]	1260
[5117]	1261	!=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
	1262	ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
	1263	str = PACK(delPhase(tname), MASK = ll) !--- Effectively found isotopes of "iname"
	1264	i%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
	1265	ALLOCATE(i%keys(i%niso))
	1266	FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
[4046]	1267
[5117]	1268	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
	1269	ll = dType=='tag' .AND. delPhase(gen0N) == iname .AND. iGen == 2
	1270	i%zone = PACK(strTail(tname, '_', .TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
	1271	CALL strReduce(i%zone)
	1272	i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname"
[4046]	1273
[5117]	1274	!=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
	1275	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
	1276	str = PACK(delPhase(tname), MASK = ll)
	1277	CALL strReduce(str)
	1278	i%ntiso = i%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntiso]
	1279	ALLOCATE(i%trac(i%ntiso))
	1280	FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
	1281	FORALL(it = i%niso + 1:i%ntiso) i%trac(it) = str(it - i%niso)
[4046]	1282
[5117]	1283	!=== Phases for tracer "iname"
	1284	i%phase = ''
	1285	DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name, addPhase(iname, ph)) /= 0) i%phase = TRIM(i%phase) // ph;
	1286	END DO
	1287	i%nphas = LEN_TRIM(i%phase) !--- Equal to "nqo" for water
[4046]	1288
[5117]	1289	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
	1290	DO iq = 1, SIZE(t)
	1291	t1 => tracers(iq)
	1292	IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname"
	1293	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
	1294	t1%iso_iName = strIdx(i%trac, strHead(delPhase(t1%name), '_', .TRUE.)) !--- Current isotope idx in effective isotopes list
	1295	t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_', .TRUE.)) !--- Current isotope zone idx in effective zones list
	1296	t1%iso_iPhase = INDEX(i%phase, TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
	1297	IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers
	1298	END DO
	1299
	1300	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
	1301	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
	1302	i%iqIsoPha = RESHAPE([((strIdx(t%name, addPhase(i%trac(it), i%phase(ip:ip))), it = 1, i%ntiso), ip = 1, i%nphas)], &
	1303	[i%ntiso, i%nphas])
	1304	!=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
	1305	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
	1306	i%iqWIsoPha = RESHAPE([([strIdx(t%name, addPhase('H2O', i%phase(ip:ip))), i%iqIsoPha(:, ip)], ip = 1, i%nphas)], &
	1307	[1 + i%ntiso, i%nphas])
	1308	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
	1309	i%itZonIso = RESHAPE([((strIdx(i%trac(:), TRIM(i%trac(it)) // '_' // TRIM(i%zone(iz))), iz = 1, i%nzone), it = 1, i%niso)], &
	1310	[i%nzone, i%niso])
[4046]	1311	END DO
	1312
[5117]	1313	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE
	1314	! lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
[4046]	1315
[5117]	1316	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
	1317	CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
[4046]	1318
[5117]	1319	!=== CHECK CONSISTENCY
	1320	lerr = testIsotopes(); IF(lerr) RETURN
[5001]	1321
[5117]	1322	!=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
	1323	IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso;
	1324	ELSE; lerr = isoSelect(1, .TRUE.);
	1325	END IF
[4325]	1326
[5117]	1327	CONTAINS
[4325]	1328
[5117]	1329	!------------------------------------------------------------------------------------------------------------------------------
	1330	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
	1331	!------------------------------------------------------------------------------------------------------------------------------
	1332	INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
	1333	TYPE(isot_type), POINTER :: i
	1334	DO ix = 1, nbIso
	1335	i => isotopes(ix)
	1336	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
	1337	DO it = 1, i%ntiso; npha = i%nphas
	1338	np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip = 1, npha)])
	1339	lerr = np /= npha
	1340	CALL msg(TRIM(int2str(np)) // ' phases instead of ' // TRIM(int2str(npha)) // ' for ' // TRIM(i%trac(it)), modname, lerr)
	1341	IF(lerr) RETURN
	1342	END DO
	1343	DO it = 1, i%niso; nzon = i%nzone
	1344	nz = SUM([(COUNT(i%trac == TRIM(i%trac(it)) // '_' // i%zone(iz)), iz = 1, nzon)])
	1345	lerr = nz /= nzon
	1346	CALL msg(TRIM(int2str(nz)) // ' tagging zones instead of ' // TRIM(int2str(nzon)) // ' for ' // TRIM(i%trac(it)), modname, lerr)
	1347	IF(lerr) RETURN
	1348	END DO
	1349	END DO
	1350	END FUNCTION testIsotopes
	1351	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1352
[5117]	1353	END FUNCTION processIsotopes
	1354	!==============================================================================================================================
[4325]	1355
[4046]	1356
[5117]	1357	!==============================================================================================================================
	1358	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
	1359	! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
	1360	!==============================================================================================================================
	1361	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
	1362	IMPLICIT NONE
	1363	CHARACTER(LEN = *), INTENT(IN) :: iName
	1364	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1365	INTEGER :: iIso
	1366	LOGICAL :: lV
	1367	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
	1368	iIso = strIdx(isotopes(:)%parent, iName)
	1369	lerr = iIso == 0
	1370	IF(lerr) THEN
	1371	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck = .FALSE.
	1372	CALL msg('no isotope family named "' // TRIM(iName) // '"', ll = lV)
[4325]	1373	RETURN
[5117]	1374	END IF
	1375	lerr = isoSelectByIndex(iIso, lV)
	1376	END FUNCTION isoSelectByName
	1377	!==============================================================================================================================
	1378	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
	1379	IMPLICIT NONE
	1380	INTEGER, INTENT(IN) :: iIso
	1381	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1382	LOGICAL :: lV
	1383	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
	1384	lerr = .FALSE.
	1385	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
	1386	lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
	1387	CALL msg('Inconsistent isotopes family index ' // TRIM(int2str(iIso)) // ': should be > 0 and <= '&
	1388	// TRIM(int2str(SIZE(isotopes))) // '"', ll = lerr .AND. lV)
	1389	IF(lerr) RETURN
	1390	ixIso = iIso !--- Update currently selected family index
	1391	isotope => isotopes(ixIso) !--- Select corresponding component
	1392	isoKeys => isotope%keys; niso = isotope%niso
	1393	isoName => isotope%trac; ntiso = isotope%ntiso
	1394	isoZone => isotope%zone; nzone = isotope%nzone
	1395	isoPhas => isotope%phase; nphas = isotope%nphas
	1396	itZonIso => isotope%itZonIso; isoCheck = isotope%check
	1397	iqIsoPha => isotope%iqIsoPha
	1398	iqWIsoPha => isotope%iqWIsoPha
	1399	END FUNCTION isoSelectByIndex
	1400	!==============================================================================================================================
[4046]	1401
	1402
[5117]	1403	!==============================================================================================================================
	1404	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
	1405	!==============================================================================================================================
	1406	SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
	1407	CHARACTER(LEN = *), INTENT(IN) :: key, sval
	1408	TYPE(keys_type), INTENT(INOUT) :: ky
	1409	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1410	!------------------------------------------------------------------------------------------------------------------------------
	1411	CHARACTER(LEN = maxlen), ALLOCATABLE :: k(:), v(:)
	1412	INTEGER :: iky, nky
	1413	LOGICAL :: lo
	1414	lo = .TRUE.; IF(PRESENT(lOverWrite)) lo = lOverWrite
	1415	IF(.NOT.ALLOCATED(ky%key)) THEN
	1416	ALLOCATE(ky%key(1)); ky%key(1) = key
	1417	ALLOCATE(ky%val(1)); ky%val(1) = sval
	1418	RETURN
	1419	END IF
	1420	iky = strIdx(ky%key, key)
	1421	IF(iky == 0) THEN
	1422	nky = SIZE(ky%key)
	1423	ALLOCATE(k(nky + 1)); k(1:nky) = ky%key; k(nky + 1) = key; ky%key = k
	1424	ALLOCATE(v(nky + 1)); v(1:nky) = ky%val; v(nky + 1) = sval; ky%val = v
	1425	ELSE IF(lo) THEN
	1426	ky%key(iky) = key; ky%val(iky) = sval
	1427	END IF
	1428	END SUBROUTINE addKey_s11
	1429	!==============================================================================================================================
	1430	SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
	1431	CHARACTER(LEN = *), INTENT(IN) :: key
	1432	INTEGER, INTENT(IN) :: ival
	1433	TYPE(keys_type), INTENT(INOUT) :: ky
	1434	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1435	!------------------------------------------------------------------------------------------------------------------------------
	1436	CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
	1437	END SUBROUTINE addKey_i11
	1438	!==============================================================================================================================
	1439	SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
	1440	CHARACTER(LEN = *), INTENT(IN) :: key
	1441	REAL, INTENT(IN) :: rval
	1442	TYPE(keys_type), INTENT(INOUT) :: ky
	1443	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1444	!------------------------------------------------------------------------------------------------------------------------------
	1445	CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
	1446	END SUBROUTINE addKey_r11
	1447	!==============================================================================================================================
	1448	SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
	1449	CHARACTER(LEN = *), INTENT(IN) :: key
	1450	LOGICAL, INTENT(IN) :: lval
	1451	TYPE(keys_type), INTENT(INOUT) :: ky
	1452	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1453	!------------------------------------------------------------------------------------------------------------------------------
	1454	CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
	1455	END SUBROUTINE addKey_l11
	1456	!==============================================================================================================================
	1457	!==============================================================================================================================
	1458	SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
	1459	CHARACTER(LEN = *), INTENT(IN) :: key, sval
	1460	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1461	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1462	!------------------------------------------------------------------------------------------------------------------------------
	1463	INTEGER :: itr
	1464	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite);
	1465	END DO
	1466	END SUBROUTINE addKey_s1m
	1467	!==============================================================================================================================
	1468	SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
	1469	CHARACTER(LEN = *), INTENT(IN) :: key
	1470	INTEGER, INTENT(IN) :: ival
	1471	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1472	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1473	!------------------------------------------------------------------------------------------------------------------------------
	1474	INTEGER :: itr
	1475	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite);
	1476	END DO
	1477	END SUBROUTINE addKey_i1m
	1478	!==============================================================================================================================
	1479	SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
	1480	CHARACTER(LEN = *), INTENT(IN) :: key
	1481	REAL, INTENT(IN) :: rval
	1482	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1483	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1484	!------------------------------------------------------------------------------------------------------------------------------
	1485	INTEGER :: itr
	1486	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite);
	1487	END DO
	1488	END SUBROUTINE addKey_r1m
	1489	!==============================================================================================================================
	1490	SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
	1491	CHARACTER(LEN = *), INTENT(IN) :: key
	1492	LOGICAL, INTENT(IN) :: lval
	1493	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1494	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1495	!------------------------------------------------------------------------------------------------------------------------------
	1496	INTEGER :: itr
	1497	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite);
	1498	END DO
	1499	END SUBROUTINE addKey_l1m
	1500	!==============================================================================================================================
	1501	!==============================================================================================================================
	1502	SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
	1503	CHARACTER(LEN = *), INTENT(IN) :: key, sval(:)
	1504	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1505	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1506	!------------------------------------------------------------------------------------------------------------------------------
	1507	INTEGER :: itr
	1508	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite);
	1509	END DO
	1510	END SUBROUTINE addKey_smm
	1511	!==============================================================================================================================
	1512	SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
	1513	CHARACTER(LEN = *), INTENT(IN) :: key
	1514	INTEGER, INTENT(IN) :: ival(:)
	1515	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1516	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1517	!------------------------------------------------------------------------------------------------------------------------------
	1518	INTEGER :: itr
	1519	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite);
	1520	END DO
	1521	END SUBROUTINE addKey_imm
	1522	!==============================================================================================================================
	1523	SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
	1524	CHARACTER(LEN = *), INTENT(IN) :: key
	1525	REAL, INTENT(IN) :: rval(:)
	1526	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1527	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1528	!------------------------------------------------------------------------------------------------------------------------------
	1529	INTEGER :: itr
	1530	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite);
	1531	END DO
	1532	END SUBROUTINE addKey_rmm
	1533	!==============================================================================================================================
	1534	SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
	1535	CHARACTER(LEN = *), INTENT(IN) :: key
	1536	LOGICAL, INTENT(IN) :: lval(:)
	1537	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1538	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1539	!------------------------------------------------------------------------------------------------------------------------------
	1540	INTEGER :: itr
	1541	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite);
	1542	END DO
	1543	END SUBROUTINE addKey_lmm
	1544	!==============================================================================================================================
[4301]	1545
	1546
[5117]	1547	!==============================================================================================================================
	1548	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
	1549	!==============================================================================================================================
	1550	SUBROUTINE addKeysFromDef(t, tr0)
	1551	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
	1552	CHARACTER(LEN = *), INTENT(IN) :: tr0
	1553	!------------------------------------------------------------------------------------------------------------------------------
	1554	CHARACTER(LEN = maxlen) :: val
	1555	INTEGER :: ik, jd
	1556	jd = strIdx(t%name, tr0)
	1557	IF(jd == 0) RETURN
	1558	DO ik = 1, SIZE(t(jd)%keys%key)
	1559	CALL get_in(t(jd)%keys%key(ik), val, 'none')
	1560	IF(val /= 'none') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
	1561	END DO
	1562	END SUBROUTINE addKeysFromDef
	1563	!==============================================================================================================================
[4301]	1564
	1565
[5117]	1566	!==============================================================================================================================
	1567	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
	1568	!==============================================================================================================================
	1569	SUBROUTINE delKey_1(itr, keyn, ky)
	1570	INTEGER, INTENT(IN) :: itr
	1571	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1572	TYPE(trac_type), INTENT(INOUT) :: ky(:)
	1573	!------------------------------------------------------------------------------------------------------------------------------
	1574	CHARACTER(LEN = maxlen), ALLOCATABLE :: k(:), v(:)
	1575	LOGICAL, ALLOCATABLE :: ll(:)
	1576	INTEGER :: iky
	1577	IF(itr<=0 .OR. itr>SIZE(ky, DIM = 1)) RETURN !--- Index is out of range
	1578	ll = [(ALL(keyn/=ky(itr)%keys%key(iky)), iky = 1, SIZE(ky(itr)%keys%key))]
	1579	k = PACK(ky(itr)%keys%key, MASK = ll); CALL MOVE_ALLOC(FROM = k, TO = ky(itr)%keys%key)
	1580	v = PACK(ky(itr)%keys%val, MASK = ll); CALL MOVE_ALLOC(FROM = v, TO = ky(itr)%keys%val)
	1581	END SUBROUTINE delKey_1
	1582	!==============================================================================================================================
	1583	SUBROUTINE delKey(keyn, ky)
	1584	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1585	TYPE(trac_type), INTENT(INOUT) :: ky(:)
	1586	!------------------------------------------------------------------------------------------------------------------------------
	1587	INTEGER :: iky
	1588	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky);
	1589	END DO
	1590	END SUBROUTINE delKey
	1591	!==============================================================================================================================
[4046]	1592
	1593
[5117]	1594	!==============================================================================================================================
	1595	!=== INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT ===
	1596	!=== IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER ===
	1597	!==============================================================================================================================
	1598	CHARACTER(LEN = maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
	1599	INTEGER, INTENT(IN) :: itr
	1600	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1601	TYPE(keys_type), INTENT(IN) :: ky(:)
	1602	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
	1603	!------------------------------------------------------------------------------------------------------------------------------
	1604	INTEGER :: ik
	1605	LOGICAL :: ler
	1606	ler = .TRUE.
	1607	DO ik = 1, SIZE(keyn)
	1608	CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
	1609	END DO
	1610	IF(PRESENT(lerr)) lerr = ler
[5001]	1611
[5117]	1612	CONTAINS
[5001]	1613
[5117]	1614	SUBROUTINE getKeyIdx(keyn)
	1615	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1616	!------------------------------------------------------------------------------------------------------------------------------
	1617	INTEGER :: iky
	1618	iky = 0; val = ''
	1619	ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
	1620	iky = strIdx(ky(itr)%key(:), keyn)
	1621	ler = iky == 0; IF(ler) RETURN
	1622	val = ky(itr)%val(iky)
	1623	END SUBROUTINE getKeyIdx
[5001]	1624
[5117]	1625	END FUNCTION fgetKeyIdx
	1626	!==============================================================================================================================
[4301]	1627
	1628
[5117]	1629	!==============================================================================================================================
	1630	!=== GET KEYS VALUES FROM TRACERS INDICES ===
	1631	!==============================================================================================================================
	1632	!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN: ===
	1633	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
	1634	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
	1635	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
	1636	!=== * A SCALAR ===
	1637	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
	1638	!=== ===
	1639	!=== SYNTAX: lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)] [, def][, lDisp]) ===
	1640	!==============================================================================================================================
	1641	!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)" ===
	1642	!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)" ===
	1643	!=== SYNTAX lerr = getKeyByIndex_{sirl}{1m}mm (keyn[(:)], val (:) [, ky(:)][, nam(:)][, def][, lDisp]) ===
	1644	!==============================================================================================================================
	1645	LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1646	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1647	CHARACTER(LEN = maxlen), INTENT(OUT) :: val
	1648	INTEGER, INTENT(IN) :: itr
	1649	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1650	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1651	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1652	lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
	1653	END FUNCTION getKeyByIndex_s111
	1654	!==============================================================================================================================
	1655	LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1656	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1657	INTEGER, INTENT(OUT) :: val
	1658	INTEGER, INTENT(IN) :: itr
	1659	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1660	INTEGER, OPTIONAL, INTENT(IN) :: def
	1661	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1662	lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
	1663	END FUNCTION getKeyByIndex_i111
	1664	!==============================================================================================================================
	1665	LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1666	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1667	REAL, INTENT(OUT) :: val
	1668	INTEGER, INTENT(IN) :: itr
	1669	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1670	REAL, OPTIONAL, INTENT(IN) :: def
	1671	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1672	lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
	1673	END FUNCTION getKeyByIndex_r111
	1674	!==============================================================================================================================
	1675	LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1676	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1677	LOGICAL, INTENT(OUT) :: val
	1678	INTEGER, INTENT(IN) :: itr
	1679	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1680	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1681	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1682	lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
	1683	END FUNCTION getKeyByIndex_l111
	1684	!==============================================================================================================================
	1685	!==============================================================================================================================
	1686	LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1687	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1688	CHARACTER(LEN = maxlen), INTENT(OUT) :: val
	1689	INTEGER, INTENT(IN) :: itr
	1690	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1691	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1692	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1693	!------------------------------------------------------------------------------------------------------------------------------
	1694	CHARACTER(LEN = maxlen) :: s
	1695	LOGICAL :: lD
	1696	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	1697	s = 'key "' // TRIM(strStack(keyn, '/')) // '" for tracer nr. ' // TRIM(int2str(itr))
	1698	lerr = .TRUE.
	1699	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
	1700	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys) !--- "tracers"
	1701	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	1702	IF(lerr .AND. PRESENT(def)) THEN
	1703	val = def; lerr = .NOT.PRESENT(def)
	1704	CALL msg('Using defaut value of ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
	1705	END IF
	1706	CALL msg('No ' // TRIM(s) // ' or out of bounds index', modname, lD .AND. lerr)
[5001]	1707
[5117]	1708	CONTAINS
[5001]	1709
[5117]	1710	CHARACTER(LEN = maxlen) FUNCTION fgetKey(ky) RESULT(val)
	1711	TYPE(keys_type), INTENT(IN) :: ky(:)
	1712	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	1713	val = fgetKeyIdx(itr, keyn(:), ky, lerr)
	1714	END FUNCTION fgetKey
[5001]	1715
[5117]	1716	END FUNCTION getKeyByIndex_sm11
	1717	!==============================================================================================================================
	1718	LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1719	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1720	INTEGER, INTENT(OUT) :: val
	1721	INTEGER, INTENT(IN) :: itr
	1722	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1723	INTEGER, OPTIONAL, INTENT(IN) :: def
	1724	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1725	!------------------------------------------------------------------------------------------------------------------------------
	1726	CHARACTER(LEN = maxlen) :: sval, s
	1727	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
	1728	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1729	IF(lerr) RETURN
	1730	val = str2int(sval)
	1731	lerr = val == -HUGE(1)
	1732	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1733	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	1734	END FUNCTION getKeyByIndex_im11
	1735	!==============================================================================================================================
	1736	LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1737	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1738	REAL, INTENT(OUT) :: val
	1739	INTEGER, INTENT(IN) :: itr
	1740	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1741	REAL, OPTIONAL, INTENT(IN) :: def
	1742	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1743	!------------------------------------------------------------------------------------------------------------------------------
	1744	CHARACTER(LEN = maxlen) :: sval, s
	1745	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
	1746	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1747	IF(lerr) RETURN
	1748	val = str2real(sval)
	1749	lerr = val == -HUGE(1.)
	1750	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1751	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	1752	END FUNCTION getKeyByIndex_rm11
	1753	!==============================================================================================================================
	1754	LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1755	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1756	LOGICAL, INTENT(OUT) :: val
	1757	INTEGER, INTENT(IN) :: itr
	1758	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1759	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1760	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1761	!------------------------------------------------------------------------------------------------------------------------------
	1762	CHARACTER(LEN = maxlen) :: sval, s
	1763	INTEGER :: ival
	1764	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
	1765	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1766	IF(lerr) RETURN
	1767	ival = str2bool(sval)
	1768	lerr = ival == -1
	1769	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1770	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	1771	IF(.NOT.lerr) val = ival == 1
	1772	END FUNCTION getKeyByIndex_lm11
	1773	!==============================================================================================================================
	1774	!==============================================================================================================================
	1775	LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1776	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1777	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1778	INTEGER, INTENT(IN) :: itr
	1779	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1780	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1781	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1782	!------------------------------------------------------------------------------------------------------------------------------
	1783	CHARACTER(LEN = maxlen) :: sval
	1784	lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
	1785	lerr = strParse(sval, ',', val)
	1786	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1787	END FUNCTION getKeyByIndex_s1m1
	1788	!==============================================================================================================================
	1789	LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1790	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1791	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1792	INTEGER, INTENT(IN) :: itr
	1793	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1794	INTEGER, OPTIONAL, INTENT(IN) :: def
	1795	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1796	!------------------------------------------------------------------------------------------------------------------------------
	1797	CHARACTER(LEN = maxlen) :: sval, s
	1798	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1799	IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
	1800	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
	1801	IF(lerr) RETURN
	1802	lerr = strParse(sval, ',', svals)
	1803	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1804	val = str2int(svals)
	1805	lerr = ANY(val == -HUGE(1))
	1806	s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1807	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	1808	END FUNCTION getKeyByIndex_i1m1
	1809	!==============================================================================================================================
	1810	LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1811	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1812	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1813	INTEGER, INTENT(IN) :: itr
	1814	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1815	REAL, OPTIONAL, INTENT(IN) :: def
	1816	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1817	!------------------------------------------------------------------------------------------------------------------------------
	1818	CHARACTER(LEN = maxlen) :: sval, s
	1819	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1820	IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
	1821	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
	1822	lerr = strParse(sval, ',', svals)
	1823	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1824	val = str2real(svals)
	1825	lerr = ANY(val == -HUGE(1.))
	1826	s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1827	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	1828	END FUNCTION getKeyByIndex_r1m1
	1829	!==============================================================================================================================
	1830	LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1831	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1832	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1833	INTEGER, INTENT(IN) :: itr
	1834	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1835	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1836	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1837	!------------------------------------------------------------------------------------------------------------------------------
	1838	CHARACTER(LEN = maxlen) :: sval, s
	1839	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1840	INTEGER, ALLOCATABLE :: ivals(:)
	1841	IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
	1842	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
	1843	lerr = strParse(sval, ',', svals)
	1844	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1845	ivals = str2bool(svals)
	1846	lerr = ANY(ivals == -1)
	1847	s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1848	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	1849	IF(.NOT.lerr) val = ivals == 1
	1850	END FUNCTION getKeyByIndex_l1m1
	1851	!==============================================================================================================================
	1852	!==============================================================================================================================
	1853	LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1854	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1855	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1856	INTEGER, INTENT(IN) :: itr
	1857	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1858	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1859	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1860	!------------------------------------------------------------------------------------------------------------------------------
	1861	CHARACTER(LEN = maxlen) :: sval
	1862	lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
	1863	lerr = strParse(sval, ',', val)
	1864	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1865	END FUNCTION getKeyByIndex_smm1
	1866	!==============================================================================================================================
	1867	LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1868	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1869	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1870	INTEGER, INTENT(IN) :: itr
	1871	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1872	INTEGER, OPTIONAL, INTENT(IN) :: def
	1873	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1874	!------------------------------------------------------------------------------------------------------------------------------
	1875	CHARACTER(LEN = maxlen) :: sval, s
	1876	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1877	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
	1878	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1879	IF(lerr) RETURN
	1880	lerr = strParse(sval, ',', svals)
	1881	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1882	val = str2int(svals)
	1883	lerr = ANY(val == -HUGE(1))
	1884	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1885	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	1886	END FUNCTION getKeyByIndex_imm1
	1887	!==============================================================================================================================
	1888	LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1889	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1890	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1891	INTEGER, INTENT(IN) :: itr
	1892	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1893	REAL, OPTIONAL, INTENT(IN) :: def
	1894	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1895	!------------------------------------------------------------------------------------------------------------------------------
	1896	CHARACTER(LEN = maxlen) :: sval, s
	1897	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1898	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
	1899	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1900	IF(lerr) RETURN
	1901	lerr = strParse(sval, ',', svals)
	1902	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1903	val = str2real(svals)
	1904	lerr = ANY(val == -HUGE(1.))
	1905	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1906	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	1907	END FUNCTION getKeyByIndex_rmm1
	1908	!==============================================================================================================================
	1909	LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1910	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1911	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1912	INTEGER, INTENT(IN) :: itr
	1913	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1914	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1915	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1916	!------------------------------------------------------------------------------------------------------------------------------
	1917	CHARACTER(LEN = maxlen) :: sval, s
	1918	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	1919	INTEGER, ALLOCATABLE :: ivals(:)
	1920	IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
	1921	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
	1922	IF(lerr) RETURN
	1923	lerr = strParse(sval, ',', svals)
	1924	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	1925	ivals = str2bool(svals)
	1926	lerr = ANY(ivals == -1)
	1927	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
	1928	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	1929	IF(.NOT.lerr) val = ivals == 1
	1930	END FUNCTION getKeyByIndex_lmm1
	1931	!==============================================================================================================================
	1932	!==============================================================================================================================
	1933	LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	1934	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1935	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1936	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1937	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1938	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1939	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1940	lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
	1941	END FUNCTION getKeyByIndex_s1mm
	1942	!==============================================================================================================================
	1943	LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	1944	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1945	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1946	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1947	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1948	INTEGER, OPTIONAL, INTENT(IN) :: def
	1949	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1950	lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
	1951	END FUNCTION getKeyByIndex_i1mm
	1952	!==============================================================================================================================
	1953	LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	1954	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1955	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1956	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1957	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1958	REAL, OPTIONAL, INTENT(IN) :: def
	1959	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1960	lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
	1961	END FUNCTION getKeyByIndex_r1mm
	1962	!==============================================================================================================================
	1963	LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	1964	CHARACTER(LEN = *), INTENT(IN) :: keyn
	1965	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1966	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1967	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1968	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1969	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1970	lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
	1971	END FUNCTION getKeyByIndex_l1mm
	1972	!==============================================================================================================================
	1973	!==============================================================================================================================
	1974	LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	1975	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	1976	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1977	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1978	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1979	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	1980	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1981	!------------------------------------------------------------------------------------------------------------------------------
	1982	CHARACTER(LEN = maxlen) :: s
	1983	CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:)
	1984	INTEGER :: iq, nq(3), k
	1985	LOGICAL :: lD, l(3)
	1986	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	1987	s = 'key "' // TRIM(strStack(keyn, '/')) // '"'
	1988	lerr = .TRUE.
	1989	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
	1990	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)%keys) !--- "tracers"
	1991	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	1992	END IF
	1993	IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
	1994	END IF
	1995	IF(.NOT.PRESENT(def)) THEN; CALL msg('No ' // TRIM(s) // ' found', modname, lD); RETURN;
	1996	END IF
[4325]	1997
[5117]	1998	!--- DEFAULT VALUE
	1999	l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
	2000	IF(l(1)) nq(1) = SIZE(ky)
	2001	IF(l(2)) nq(2) = SIZE(tracers)
	2002	IF(l(3)) nq(3) = SIZE(isotope%keys)
	2003	DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT;
	2004	END IF;
	2005	END DO
	2006	lerr = k == 4
	2007	CALL msg('Using defaut value for ' // TRIM(s) // ': ' // TRIM(def), modname, lD .AND. .NOT.lerr)
	2008	CALL msg('No ' // TRIM(s), modname, lD .AND. lerr)
[4325]	2009
[5117]	2010	CONTAINS
[4325]	2011
[5117]	2012	FUNCTION fgetKey(ky) RESULT(val)
	2013	CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:)
	2014	TYPE(keys_type), INTENT(IN) :: ky(:)
	2015	LOGICAL :: ler(SIZE(ky))
	2016	INTEGER :: iq
	2017	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	2018	tname = ky%name
	2019	val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
	2020	lerr = ANY(ler)
	2021	END FUNCTION fgetKey
[4325]	2022
[5117]	2023	END FUNCTION getKeyByIndex_smmm
	2024	!==============================================================================================================================
	2025	LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	2026	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	2027	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2028	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2029	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	2030	INTEGER, OPTIONAL, INTENT(IN) :: def
	2031	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2032	!------------------------------------------------------------------------------------------------------------------------------
	2033	CHARACTER(LEN = maxlen) :: s
	2034	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
	2035	LOGICAL, ALLOCATABLE :: ll(:)
	2036	IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, int2str(def), lDisp)
	2037	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
	2038	IF(lerr) RETURN
	2039	val = str2int(svals)
	2040	ll = val == -HUGE(1)
	2041	lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
	2042	END IF
	2043	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(PACK(tname, MASK = ll))) // ' is not'
	2044	CALL msg(TRIM(s) // ' an integer: ' // TRIM(strStack(svals, MASK = ll)), modname, lerr)
	2045	IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
	2046	END FUNCTION getKeyByIndex_immm
	2047	!==============================================================================================================================
	2048	LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	2049	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	2050	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2051	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2052	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	2053	REAL, OPTIONAL, INTENT(IN) :: def
	2054	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2055	!------------------------------------------------------------------------------------------------------------------------------
	2056	CHARACTER(LEN = maxlen) :: s
	2057	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
	2058	LOGICAL, ALLOCATABLE :: ll(:)
	2059	IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, real2str(def), lDisp)
	2060	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
	2061	IF(lerr) RETURN
	2062	val = str2real(svals)
	2063	ll = val == -HUGE(1.)
	2064	lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
	2065	END IF
	2066	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(PACK(tname, MASK = ll))) // ' is not a'
	2067	CALL msg(TRIM(s) // ' a real: ' // TRIM(strStack(svals, MASK = ll)), modname)
	2068	END FUNCTION getKeyByIndex_rmmm
	2069	!==============================================================================================================================
	2070	LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
	2071	CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
	2072	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2073	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2074	CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	2075	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2076	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2077	!------------------------------------------------------------------------------------------------------------------------------
	2078	CHARACTER(LEN = maxlen) :: s
	2079	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
	2080	LOGICAL, ALLOCATABLE :: ll(:)
	2081	INTEGER, ALLOCATABLE :: ivals(:)
	2082	IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, bool2str(def), lDisp)
	2083	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
	2084	IF(lerr) RETURN
	2085	ivals = str2bool(svals)
	2086	ll = ivals == -1
	2087	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN;
	2088	END IF
	2089	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
	2090	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(strStack(svals, MASK = ll)), modname)
	2091	END FUNCTION getKeyByIndex_lmmm
	2092	!==============================================================================================================================
[5001]	2093
	2094
	2095
[5117]	2096	!==============================================================================================================================
	2097	!=== GET KEYS VALUES FROM TRACERS NAMES ===
	2098	!==============================================================================================================================
	2099	!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN: ===
	2100	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
	2101	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
	2102	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
	2103	!=== * A SCALAR ===
	2104	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
	2105	!=== ===
	2106	!=== SYNTAX: lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname [, ky(:)][, def][, lDisp]) ===
	2107	!==============================================================================================================================
	2108	!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)" ===
	2109	!=== ===
	2110	!=== SYNTAX lerr = getKeyByName_{sirl}{1m}mm (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp]) ===
	2111	!==============================================================================================================================
	2112	LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2113	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2114	CHARACTER(LEN = maxlen), INTENT(OUT) :: val
	2115	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2116	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2117	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2118	lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
	2119	END FUNCTION getKeyByName_s111
	2120	!==============================================================================================================================
	2121	LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2122	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2123	INTEGER, INTENT(OUT) :: val
	2124	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2125	INTEGER, OPTIONAL, INTENT(IN) :: def
	2126	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2127	lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
	2128	END FUNCTION getKeyByName_i111
	2129	!==============================================================================================================================
	2130	LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2131	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2132	REAL, INTENT(OUT) :: val
	2133	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2134	REAL, OPTIONAL, INTENT(IN) :: def
	2135	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2136	lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
	2137	END FUNCTION getKeyByName_r111
	2138	!==============================================================================================================================
	2139	LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2140	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2141	LOGICAL, INTENT(OUT) :: val
	2142	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2143	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2144	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2145	lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
	2146	END FUNCTION getKeyByName_l111
	2147	!==============================================================================================================================
	2148	!==============================================================================================================================
	2149	LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2150	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2151	CHARACTER(LEN = maxlen), INTENT(OUT) :: val
	2152	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2153	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2154	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2155	!------------------------------------------------------------------------------------------------------------------------------
	2156	CHARACTER(LEN = maxlen) :: s, tnam
	2157	LOGICAL :: lD
	2158	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	2159	s = 'key "' // TRIM(strStack(keyn, '/')) // '" for "' // TRIM(tname) // '"'
	2160	lerr = .TRUE.
	2161	tnam = strHead(delPhase(tname), '_', .TRUE.) !--- Remove phase and tag
	2162	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
	2163	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys) !--- "tracers"
	2164	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	2165	IF(lerr .AND. PRESENT(def)) THEN
	2166	val = def; lerr = .NOT.PRESENT(def)
	2167	CALL msg('Using defaut value of ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
	2168	END IF
	2169	CALL msg('No ' // TRIM(s) // ' or out of bounds index', modname, lD .AND. lerr)
[5001]	2170
[5117]	2171	CONTAINS
[5001]	2172
[5117]	2173	CHARACTER(LEN = maxlen) FUNCTION fgetKey(ky) RESULT(val)
	2174	TYPE(keys_type), INTENT(IN) :: ky(:)
	2175	lerr = SIZE(ky) == 0
	2176	IF(lerr) RETURN
	2177	val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
	2178	IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam), [keyn], ky, lerr)
[5001]	2179
[5117]	2180	END FUNCTION fgetKey
[5001]	2181
[5117]	2182	END FUNCTION getKeyByName_sm11
	2183	!==============================================================================================================================
	2184	LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2185	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2186	INTEGER, INTENT(OUT) :: val
	2187	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2188	INTEGER, OPTIONAL, INTENT(IN) :: def
	2189	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2190	!------------------------------------------------------------------------------------------------------------------------------
	2191	CHARACTER(LEN = maxlen) :: sval, s
	2192	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
	2193	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2194	IF(lerr) RETURN
	2195	val = str2int(sval)
	2196	lerr = val == -HUGE(1)
	2197	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2198	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	2199	END FUNCTION getKeyByName_im11
	2200	!==============================================================================================================================
	2201	LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2202	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2203	REAL, INTENT(OUT) :: val
	2204	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2205	REAL, OPTIONAL, INTENT(IN) :: def
	2206	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2207	!------------------------------------------------------------------------------------------------------------------------------
	2208	CHARACTER(LEN = maxlen) :: sval, s
	2209	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
	2210	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2211	IF(lerr) RETURN
	2212	val = str2real(sval)
	2213	lerr = val == -HUGE(1.)
	2214	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2215	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	2216	END FUNCTION getKeyByName_rm11
	2217	!==============================================================================================================================
	2218	LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2219	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2220	LOGICAL, INTENT(OUT) :: val
	2221	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2222	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2223	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2224	!------------------------------------------------------------------------------------------------------------------------------
	2225	CHARACTER(LEN = maxlen) :: sval, s
	2226	INTEGER :: ival
	2227	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
	2228	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2229	IF(lerr) RETURN
	2230	ival = str2bool(sval)
	2231	lerr = ival == -1
	2232	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2233	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	2234	IF(.NOT.lerr) val = ival == 1
	2235	END FUNCTION getKeyByName_lm11
	2236	!==============================================================================================================================
	2237	!==============================================================================================================================
	2238	LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2239	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2240	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2241	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2242	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2243	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2244	!------------------------------------------------------------------------------------------------------------------------------
	2245	CHARACTER(LEN = maxlen) :: sval
	2246	lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
	2247	lerr = strParse(sval, ',', val)
	2248	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2249	END FUNCTION getKeyByName_s1m1
	2250	!==============================================================================================================================
	2251	LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2252	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2253	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2254	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2255	INTEGER, OPTIONAL, INTENT(IN) :: def
	2256	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2257	!------------------------------------------------------------------------------------------------------------------------------
	2258	CHARACTER(LEN = maxlen) :: sval, s
	2259	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2260	IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
	2261	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
	2262	IF(lerr) RETURN
	2263	lerr = strParse(sval, ',', svals)
	2264	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2265	val = str2int(svals)
	2266	lerr = ANY(val == -HUGE(1))
	2267	s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
	2268	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	2269	END FUNCTION getKeyByName_i1m1
	2270	!==============================================================================================================================
	2271	LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2272	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2273	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2274	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2275	REAL, OPTIONAL, INTENT(IN) :: def
	2276	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2277	!------------------------------------------------------------------------------------------------------------------------------
	2278	CHARACTER(LEN = maxlen) :: sval, s
	2279	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2280	IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
	2281	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
	2282	IF(lerr) RETURN
	2283	lerr = strParse(sval, ',', svals)
	2284	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2285	val = str2real(svals)
	2286	lerr = ANY(val == -HUGE(1.))
	2287	s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
	2288	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	2289	END FUNCTION getKeyByName_r1m1
	2290	!==============================================================================================================================
	2291	LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2292	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
	2293	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2294	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2295	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2296	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2297	!------------------------------------------------------------------------------------------------------------------------------
	2298	CHARACTER(LEN = maxlen) :: sval, s
	2299	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2300	INTEGER, ALLOCATABLE :: ivals(:)
	2301	IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
	2302	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
	2303	IF(lerr) RETURN
	2304	lerr = strParse(sval, ',', svals)
	2305	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2306	ivals = str2bool(svals)
	2307	lerr = ANY(ivals == -1)
	2308	s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
	2309	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	2310	IF(.NOT.lerr) val = ivals == 1
	2311	END FUNCTION getKeyByName_l1m1
	2312	!==============================================================================================================================
	2313	!==============================================================================================================================
	2314	LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2315	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2316	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2317	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2318	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2319	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2320	!------------------------------------------------------------------------------------------------------------------------------
	2321	CHARACTER(LEN = maxlen) :: sval
	2322	lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
	2323	lerr = strParse(sval, ',', val)
	2324	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2325	END FUNCTION getKeyByName_smm1
	2326	!==============================================================================================================================
	2327	LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2328	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2329	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2330	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2331	INTEGER, OPTIONAL, INTENT(IN) :: def
	2332	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2333	!------------------------------------------------------------------------------------------------------------------------------
	2334	CHARACTER(LEN = maxlen) :: sval, s
	2335	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2336	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
	2337	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2338	IF(lerr) RETURN
	2339	lerr = strParse(sval, ',', svals)
	2340	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2341	val = str2int(svals)
	2342	lerr = ANY(val == -HUGE(1))
	2343	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2344	CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
	2345	END FUNCTION getKeyByName_imm1
	2346	!==============================================================================================================================
	2347	LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2348	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2349	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2350	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2351	REAL, OPTIONAL, INTENT(IN) :: def
	2352	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2353	!------------------------------------------------------------------------------------------------------------------------------
	2354	CHARACTER(LEN = maxlen) :: sval, s
	2355	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2356	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
	2357	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2358	IF(lerr) RETURN
	2359	lerr = strParse(sval, ',', svals)
	2360	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2361	val = str2real(svals)
	2362	lerr = ANY(val == -HUGE(1.))
	2363	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2364	CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
	2365	END FUNCTION getKeyByName_rmm1
	2366	!==============================================================================================================================
	2367	LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2368	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
	2369	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2370	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2371	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2372	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2373	!------------------------------------------------------------------------------------------------------------------------------
	2374	CHARACTER(LEN = maxlen) :: sval, s
	2375	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2376	INTEGER, ALLOCATABLE :: ivals(:)
	2377	IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
	2378	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
	2379	IF(lerr) RETURN
	2380	lerr = strParse(sval, ',', svals)
	2381	IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
	2382	ivals = str2bool(svals)
	2383	lerr = ANY(ivals == -1)
	2384	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
	2385	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
	2386	IF(.NOT.lerr) val = ivals == 1
	2387	END FUNCTION getKeyByName_lmm1
	2388	!==============================================================================================================================
	2389	!==============================================================================================================================
	2390	LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2391	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
	2392	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2393	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2394	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2395	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2396	lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
	2397	END FUNCTION getKeyByName_s1mm
	2398	!==============================================================================================================================
	2399	LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2400	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
	2401	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2402	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2403	INTEGER, OPTIONAL, INTENT(IN) :: def
	2404	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2405	lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
	2406	END FUNCTION getKeyByName_i1mm
	2407	!==============================================================================================================================
	2408	LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2409	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
	2410	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2411	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2412	REAL, OPTIONAL, INTENT(IN) :: def
	2413	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2414	lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
	2415	END FUNCTION getKeyByName_r1mm
	2416	!==============================================================================================================================
	2417	LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2418	CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
	2419	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2420	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2421	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2422	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2423	lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
	2424	END FUNCTION getKeyByName_l1mm
	2425	!==============================================================================================================================
	2426	!==============================================================================================================================
	2427	LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2428	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
	2429	CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2430	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2431	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
	2432	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2433	!------------------------------------------------------------------------------------------------------------------------------
	2434	CHARACTER(LEN = maxlen) :: s
	2435	INTEGER :: iq, nq
	2436	LOGICAL :: lD
	2437	nq = SIZE(tname); ALLOCATE(val(nq))
	2438	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	2439	s = 'key "' // TRIM(strStack(keyn, '/')) // '"'
	2440	lerr = .TRUE.
	2441	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
	2442	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)%keys) !--- "tracers"
	2443	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	2444	END IF
	2445	IF(.NOT.PRESENT(def)) THEN; CALL msg('No ' // TRIM(s) // ' found', modname, lD); RETURN;
	2446	END IF
[5001]	2447
[5117]	2448	!--- DEFAULT VALUE
	2449	val = [(def, iq = 1, SIZE(tname))]
	2450	CALL msg('Using defaut value for ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
[5001]	2451
[5117]	2452	CONTAINS
[5001]	2453
[5117]	2454	FUNCTION fgetKey(ky) RESULT(val)
	2455	CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:)
	2456	TYPE(keys_type), INTENT(IN) :: ky(:)
	2457	LOGICAL, ALLOCATABLE :: ler(:)
	2458	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	2459	ALLOCATE(ler(SIZE(tname)))
	2460	val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
	2461	lerr = ANY(ler)
	2462	END FUNCTION fgetKey
[5001]	2463
[5117]	2464	END FUNCTION getKeyByName_smmm
	2465	!==============================================================================================================================
	2466	LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2467	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
	2468	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2469	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2470	INTEGER, OPTIONAL, INTENT(IN) :: def
	2471	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2472	!------------------------------------------------------------------------------------------------------------------------------
	2473	CHARACTER(LEN = maxlen) :: s
	2474	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2475	LOGICAL, ALLOCATABLE :: ll(:)
	2476	IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
	2477	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
	2478	IF(lerr) RETURN
	2479	val = str2int(svals)
	2480	ll = val == -HUGE(1)
	2481	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2482	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
	2483	CALL msg(TRIM(s) // ' an integer: ' // TRIM(strStack(svals, MASK = ll)), modname)
	2484	END FUNCTION getKeyByName_immm
	2485	!==============================================================================================================================
	2486	LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2487	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
	2488	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2489	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2490	REAL, OPTIONAL, INTENT(IN) :: def
	2491	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2492	!------------------------------------------------------------------------------------------------------------------------------
	2493	CHARACTER(LEN = maxlen) :: s
	2494	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2495	LOGICAL, ALLOCATABLE :: ll(:)
	2496	IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
	2497	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
	2498	IF(lerr) RETURN
	2499	val = str2real(svals)
	2500	ll = val == -HUGE(1.)
	2501	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2502	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
	2503	CALL msg(TRIM(s) // ' a real: ' // TRIM(strStack(svals, MASK = ll)), modname)
	2504	END FUNCTION getKeyByName_rmmm
	2505	!==============================================================================================================================
	2506	LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2507	CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
	2508	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2509	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2510	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2511	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2512	!------------------------------------------------------------------------------------------------------------------------------
	2513	CHARACTER(LEN = maxlen) :: s
	2514	CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
	2515	LOGICAL, ALLOCATABLE :: ll(:)
	2516	INTEGER, ALLOCATABLE :: ivals(:)
	2517	IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
	2518	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
	2519	IF(lerr) RETURN
	2520	ivals = str2bool(svals)
	2521	ll = ivals == -1
	2522	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN;
	2523	END IF
	2524	s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
	2525	CALL msg(TRIM(s) // ' a boolean: ' // TRIM(strStack(svals, MASK = ll)), modname)
	2526	END FUNCTION getKeyByName_lmmm
	2527	!==============================================================================================================================
[4046]	2528
	2529
[5117]	2530	!==============================================================================================================================
	2531	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
	2532	!==============================================================================================================================
	2533	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
	2534	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
	2535	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
	2536	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
	2537	!------------------------------------------------------------------------------------------------------------------------------
	2538	TYPE(isot_type), ALLOCATABLE :: iso(:)
	2539	INTEGER :: ix, nbIso
	2540	IF(PRESENT(tracers_)) THEN; tracers = tracers_;
	2541	ELSE; ALLOCATE(tracers(0));
[4325]	2542	END IF
[5117]	2543	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_;
	2544	ELSE; ALLOCATE(isotopes(0));
	2545	END IF
	2546	IF(PRESENT(isotope_)) THEN
	2547	ix = strIdx(isotopes(:)%parent, isotope_%parent)
	2548	IF(ix /= 0) THEN
	2549	isotopes(ix) = isotope_
	2550	ELSE
	2551	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso + 1)); iso(1:nbIso) = isotopes; iso(nbIso + 1) = isotope_
	2552	CALL MOVE_ALLOC(FROM = iso, TO = isotopes)
	2553	END IF
	2554	END IF
	2555	END SUBROUTINE setKeysDBase
	2556	!==============================================================================================================================
	2557	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
	2558	TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
	2559	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
	2560	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
	2561	!------------------------------------------------------------------------------------------------------------------------------
	2562	INTEGER :: ix
	2563	IF(PRESENT(tracers_)) THEN; tracers_ = tracers;
	2564	ELSE; ALLOCATE(tracers_(0));
	2565	END IF
	2566	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes;
	2567	ELSE; ALLOCATE(isotopes_(0));
	2568	END IF
	2569	IF(PRESENT(isotope_)) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_ = isotopes(ix);
	2570	END IF
	2571	END SUBROUTINE getKeysDBase
	2572	!==============================================================================================================================
[4325]	2573
	2574
[5117]	2575	!==============================================================================================================================
	2576	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
	2577	!==============================================================================================================================
	2578	ELEMENTAL CHARACTER(LEN = maxlen) FUNCTION delPhase(s) RESULT(OUT)
	2579	CHARACTER(LEN = *), INTENT(IN) :: s
	2580	!------------------------------------------------------------------------------------------------------------------------------
	2581	INTEGER :: ix, ip, ns
	2582	out = s; ns = LEN_TRIM(s)
	2583	IF(s == '' .OR. ns<=2) RETURN !--- Empty string or LEN(name)<=2: nothing to DO
	2584	IF(s(1:3)=='H2O' .AND. INDEX(old_phases, s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
	2585	out = 'H2O' // s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
	2586	ELSE IF(s(ns - 1:ns - 1)==phases_sep .AND. INDEX(known_phases, s(ns:ns))/=0) THEN
	2587	out = s(1:ns - 2); RETURN !--- <var><phase_sep><phase>
	2588	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep // known_phases(ip:ip) // '_'); IF(ix /= 0) EXIT;
	2589	END DO
	2590	IF(ip /= nphases + 1) out = s(1:ix - 1) // s(ix + 2:ns) !--- <var><phase_sep><phase>_<tag>
	2591	END IF
	2592	END FUNCTION delPhase
	2593	!==============================================================================================================================
	2594	CHARACTER(LEN = maxlen) FUNCTION addPhase_s1(s, pha) RESULT(OUT)
	2595	CHARACTER(LEN = *), INTENT(IN) :: s
	2596	CHARACTER(LEN = 1), INTENT(IN) :: pha
	2597	!------------------------------------------------------------------------------------------------------------------------------
	2598	INTEGER :: l, i
	2599	out = s
	2600	IF(s == '') RETURN !--- Empty string: nothing to DO
	2601	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
	2602	l = LEN_TRIM(s)
	2603	IF(i == 0) out = TRIM(s) // phases_sep // pha !--- <var> => return <var><sep><pha>
	2604	IF(i /= 0) out = s(1:i - 1) // phases_sep // pha // '_' // s(i + 1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
	2605	END FUNCTION addPhase_s1
	2606	!==============================================================================================================================
	2607	FUNCTION addPhase_sm(s, pha) RESULT(OUT)
	2608	CHARACTER(LEN = *), INTENT(IN) :: s(:)
	2609	CHARACTER(LEN = 1), INTENT(IN) :: pha
	2610	CHARACTER(LEN = maxlen), ALLOCATABLE :: out(:)
	2611	!------------------------------------------------------------------------------------------------------------------------------
	2612	INTEGER :: k
	2613	out = [(addPhase_s1(s(k), pha), k = 1, SIZE(s))]
	2614	END FUNCTION addPhase_sm
	2615	!==============================================================================================================================
	2616	CHARACTER(LEN = maxlen) FUNCTION addPhase_i1(s, ipha, phases) RESULT(OUT)
	2617	CHARACTER(LEN = *), INTENT(IN) :: s
	2618	INTEGER, INTENT(IN) :: ipha
	2619	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
	2620	!------------------------------------------------------------------------------------------------------------------------------
	2621	out = s
	2622	IF(s == '') RETURN !--- Empty string: nothing to DO
	2623	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
	2624	IF(PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
	2625	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
	2626	END FUNCTION addPhase_i1
	2627	!==============================================================================================================================
	2628	FUNCTION addPhase_im(s, ipha, phases) RESULT(OUT)
	2629	CHARACTER(LEN = *), INTENT(IN) :: s(:)
	2630	INTEGER, INTENT(IN) :: ipha
	2631	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
	2632	CHARACTER(LEN = maxlen), ALLOCATABLE :: out(:)
	2633	!------------------------------------------------------------------------------------------------------------------------------
	2634	INTEGER :: k
	2635	IF(PRESENT(phases)) out = [(addPhase_i1(s(k), ipha, phases), k = 1, SIZE(s))]
	2636	IF(.NOT.PRESENT(phases)) out = [(addPhase_i1(s(k), ipha, known_phases), k = 1, SIZE(s))]
	2637	END FUNCTION addPhase_im
	2638	!==============================================================================================================================
[4046]	2639
	2640
[5117]	2641	!==============================================================================================================================
	2642	!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
	2643	!==============================================================================================================================
	2644	LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
	2645	CHARACTER(LEN = *), INTENT(IN) :: tname
	2646	TYPE(keys_type), INTENT(IN) :: keys
	2647	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
	2648	TYPE(trac_type), ALLOCATABLE :: tr(:)
	2649	CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
	2650	INTEGER :: nt, ix
	2651	IF(ALLOCATED(tracs)) THEN
	2652	lerr = getKey('name', tnames, ky = tracs(:)%keys); IF(lerr) RETURN
	2653	nt = SIZE(tracs)
	2654	ix = strIdx(tnames, tname)
	2655	CALL msg('Modifying existing tracer "' // TRIM(tname) // '"', modname, ix /= 0)
	2656	CALL msg('Appending with tracer "' // TRIM(tname) // '"', modname, ix == 0)
	2657	IF(ix == 0) THEN
	2658	ix = nt + 1; ALLOCATE(tr(nt + 1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM = tr, TO = tracs)
	2659	END IF
	2660	ELSE
	2661	CALL msg('Creating a tracer descriptor with tracer "' // TRIM(tname) // '"', modname)
	2662	ix = 1; ALLOCATE(tracs(1))
	2663	END IF
	2664	CALL addKey('name', tname, tracs(ix)%keys)
	2665	tracs(ix)%name = tname
	2666	tracs(ix)%keys = keys
[5001]	2667
[5117]	2668	END FUNCTION addTracer_1
	2669	!==============================================================================================================================
	2670	LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
	2671	CHARACTER(LEN = *), INTENT(IN) :: tname
	2672	TYPE(keys_type), INTENT(IN) :: keys
	2673	lerr = addTracer_1(tname, keys, tracers)
	2674	END FUNCTION addTracer_1def
	2675	!==============================================================================================================================
[4987]	2676
	2677
[5117]	2678	!==============================================================================================================================
	2679	LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
	2680	CHARACTER(LEN = *), INTENT(IN) :: tname
	2681	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
	2682	TYPE(trac_type), ALLOCATABLE :: tr(:)
	2683	CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
	2684	INTEGER :: nt, ix
	2685	lerr = .NOT.ALLOCATED(tracs)
	2686	IF(fmsg('Can''t remove tracer "' // TRIM(tname) // '" from an empty tracers descriptor', modname, lerr)) RETURN
	2687	nt = SIZE(tracs)
	2688	lerr = getKey('name', tnames, ky = tracs(:)%keys); IF(lerr) RETURN
	2689	ix = strIdx(tnames, tname)
	2690	CALL msg('Removing tracer "' // TRIM(tname) // '"', modname, ix /= 0)
	2691	CALL msg('Can''t remove unknown tracer "' // TRIM(tname) // '"', modname, ix == 0)
	2692	IF(ix /= 0) THEN
	2693	ALLOCATE(tr(nt - 1)); tr(1:ix - 1) = tracs(1:ix - 1); tr(ix:nt - 1) = tracs(ix + 1:nt); CALL MOVE_ALLOC(FROM = tr, TO = tracs)
	2694	END IF
	2695	END FUNCTION delTracer_1
	2696	!==============================================================================================================================
	2697	LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
	2698	CHARACTER(LEN = *), INTENT(IN) :: tname
	2699	lerr = delTracer(tname, tracers)
	2700	END FUNCTION delTracer_1def
	2701	!==============================================================================================================================
[4987]	2702
	2703
[5117]	2704	!==============================================================================================================================
	2705	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
	2706	!==============================================================================================================================
	2707	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
	2708	CHARACTER(LEN = *), INTENT(IN) :: tname
	2709	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
	2710	!------------------------------------------------------------------------------------------------------------------------------
	2711	CHARACTER(LEN = maxlen) :: phase
	2712	IF(PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
	2713	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
	2714	END FUNCTION getiPhase
	2715	!==============================================================================================================================
	2716	CHARACTER(LEN = 1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
	2717	CHARACTER(LEN = *), INTENT(IN) :: tname
	2718	CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
	2719	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
	2720	!------------------------------------------------------------------------------------------------------------------------------
	2721	INTEGER :: ip
	2722	phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
	2723	IF(PRESENT(phases)) ip = INDEX(phases, phase)
	2724	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
	2725	IF(ip == 0) phase = 'g'
	2726	IF(PRESENT(iPhase)) iPhase = ip
	2727	END FUNCTION getPhase
	2728	!==============================================================================================================================
[4067]	2729
[4120]	2730
[5117]	2731	!==============================================================================================================================
	2732	!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
	2733	!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
	2734	!==============================================================================================================================
	2735	CHARACTER(LEN = maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
	2736	CHARACTER(LEN = *), INTENT(IN) :: oldName
	2737	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
	2738	!------------------------------------------------------------------------------------------------------------------------------
	2739	CHARACTER(LEN = maxlen), ALLOCATABLE :: tmp(:)
	2740	INTEGER :: ix, ip, nt
	2741	LOGICAL :: lerr
	2742	newName = oldName
	2743	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
	2744	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
	2745	ip = strIdx([('H2O' // old_phases(ix:ix), ix = 1, nphases)], tmp(1)) !--- Phase index
	2746	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
	2747	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
	2748	IF(nt == 1) THEN
	2749	newName = addPhase('H2O', ip) !=== WATER WITH OR WITHOUT PHASE
	2750	ELSE
	2751	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
	2752	IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name
	2753	IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name
	2754	IF(nt == 3) newName = TRIM(newName) // '_' // TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER
	2755	END IF
	2756	END FUNCTION old2newH2O_1
	2757	!==============================================================================================================================
	2758	FUNCTION old2newH2O_m(oldName) RESULT(newName)
	2759	CHARACTER(LEN = *), INTENT(IN) :: oldName(:)
	2760	CHARACTER(LEN = maxlen) :: newName(SIZE(oldName))
	2761	!------------------------------------------------------------------------------------------------------------------------------
	2762	INTEGER :: i
	2763	newName = [(old2newH2O_1(oldName(i)), i = 1, SIZE(oldName))]
	2764	END FUNCTION old2newH2O_m
	2765	!==============================================================================================================================
[4120]	2766
[4301]	2767
[5117]	2768	!==============================================================================================================================
	2769	!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
	2770	!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
	2771	!==============================================================================================================================
	2772	CHARACTER(LEN = maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
	2773	CHARACTER(LEN = *), INTENT(IN) :: newName
	2774	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
	2775	!------------------------------------------------------------------------------------------------------------------------------
	2776	INTEGER :: ix, ip
	2777	CHARACTER(LEN = maxlen) :: var
	2778	oldName = newName
	2779	ip = getiPhase(newName) !--- Phase index
	2780	IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous)
	2781	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag
	2782	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
	2783	IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished
	2784	oldName = 'H2O'
	2785	IF(ip /= 0) oldName = TRIM(oldName) // old_phases(ip:ip) !--- Add phase if needed
	2786	IF(ix /= 0) oldName = TRIM(oldName) // '_' // oldH2OIso(ix) !--- H2O isotope name
	2787	IF(newName /= addPhase(var, ip)) &
	2788	oldName = TRIM(oldName) // strTail(newName, '_', .TRUE.) !--- Add the tag suffix
	2789	IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix
	2790	END FUNCTION new2oldH2O_1
	2791	!==============================================================================================================================
	2792	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
	2793	CHARACTER(LEN = *), INTENT(IN) :: newName(:)
	2794	CHARACTER(LEN = maxlen) :: oldName(SIZE(newName))
	2795	!------------------------------------------------------------------------------------------------------------------------------
	2796	INTEGER :: i
	2797	oldName = [(new2oldH2O_1(newName(i)), i = 1, SIZE(newName))]
	2798	END FUNCTION new2oldH2O_m
	2799	!==============================================================================================================================
[4120]	2800
[5117]	2801	END MODULE lmdz_readTracFiles

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

Download in other formats:

Original Format